(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") (il:filecreated "24-Oct-86 12:49:53" ("compiled on " il:{eris}zebra>defstruct.\;30) "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 "24-Oct-86 12:48:48" il:{eris}zebra>defstruct.\;30 52891 il:|changes| il:|to:| (il:functions %structure-type-to-fieldspec set-parsed-structure find-slot create-boa-constructor boa-slot-setfs boa-arg-list-with-initial-values define-constructors assign-structure-representation ensure-consistent-ps defstruct-slot-to-datatype-fieldspec defstruct-assert-subtypep) (il:vars il:defstructcoms) 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: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-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 create-boa-constructor 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: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:|;;;| "Internal interface") (il:functions set-parsed-structure) (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:setf-macro-function (quote il:defstruct) nil) (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:a1351 (quote il:structures)) (il:a1352 il:*definition-hash-table*) (il:a1354 (make-hash-table (quote :test) (quote equal) (quote :size) 50 (quote :rehash-size) 50))) (puthash il:a1351 il:a1352 il:a1354)))) (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:a1355 (quote declare-structure)) (il:a1356 (quote function)) (il:a1357 "accomplishes all the work of declaring a structure.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1355 il:a1356 il:a1357))) il:a1357)) (let* ((il:a1359 (quote ps)) (il:a1360 (quote structure)) (il:a1361 "contains the parsed information for a SINGLE structure type")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1359 il:a1360 il:a1361))) il:a1361)) 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:a1419 (quote insert-included-slot)) (il:a1420 (quote function)) (il:a1421 "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:a1419 il:a1420 il:a1421))) il:a1421)) merge-slots il:d1 (il:l (2 ps 1 super-slots 0 included-slots)) @HAAB HX(14 insert-included-slot) nil () (let* ((il:a1423 (quote merge-slots)) (il:a1424 (quote function)) (il:a1425 "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:a1423 il:a1424 il:a1425 ))) il:a1425)) 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:a1426 (quote name-slot)) (il:a1427 (quote function)) (il:a1428 "returns a parsed-slot representing the 'name' field of a structure")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1426 il:a1427 il:a1428))) il:a1428)) 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:a1429 (quote add-initial-offset-slots)) (il:a1430 (quote function)) (il:a1431 "adds parsed-slots to the local-slots to represent the initial offset.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1429 il:a1430 il:a1431))) il:a1431)) pack-datatype-fieldspecs il:d1 (il:l (0 field-specs)) @nil nil () (let* ((il:a1432 (quote pack-datatype-fieldspecs)) (il:a1433 (quote function)) (il:a1434 "dummy")) ( progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1432 il:a1433 il:a1434)) ) il:a1434)) 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 si::%structure-declare-datatype 34 defstruct-slot-to-datatype-fieldspec 28 datatype 17 list 10 vector) ( 67 "~s is not a defined structure") (let* ((il:a1436 (quote assign-structure-representation)) (il:a1437 (quote function)) (il:a1438 "Determines the descriptors and returns a form to create the datatype at loadtime.")) (progn (cond (( fboundp (quote il:set-documentation)) (il:set-documentation il:a1436 il:a1437 il:a1438))) il:a1438)) 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:a1439 (quote define-structure-type)) (il:a1440 (quote function)) (il:a1441 "adds the structure to the common lisp type system with deftype.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1439 il:a1440 il:a1441))) il:a1441)) defstruct-slot-to-datatype-fieldspec il:d1 (il:l (0 slot)) @ (6 %structure-type-to-fieldspec 3 pslot-type) nil () (let* ((il:a1442 (quote defstruct-slot-to-datatype-fieldspec)) (il:a1443 (quote function)) (il:a1444 "given a parsed-slot returns a datatype fieldspec that will contain it.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1442 il:a1443 il:a1444))) il:a1444)) %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:a1448 (quote assign-field-descriptors)) (il:a1449 (quote function)) (il:a1450 "assigns the field descriptors for accessing each slot of the structure")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1448 il:a1449 il:a1450))) il:a1450)) 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:a1451 (quote define-accessors)) (il:a1452 (quote function)) (il:a1453 "returns the forms that when evaluated, define the accessors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1451 il:a1452 il:a1453))) il:a1453)) 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:a1455 (quote pslot-internal-accessor)) (il:a1456 (quote function)) (il:a1457 "returns a form which fetches slot from argument")) (progn (cond ((fboundp (quote il:set-documentation )) (il:set-documentation il:a1455 il:a1456 il:a1457))) il:a1457)) 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:a1458 (quote define-setfs)) (il:a1459 (quote function)) (il:a1460 "returns the forms that when evaluated, define the setf's for the slots.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1458 il:a1459 il:a1460))) il:a1460)) setf-name il:d1 (il:l (0 accessor-name)) g@h (9 xcl:pack) (2 %%setf-) () (let* ((il:a1461 (quote setf-name)) (il:a1462 (quote function)) (il:a1463 "produces the name of the setf function for this accessor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1461 il:a1462 il:a1463))) il:a1463)) define-constructors il:d1 (il:l (0 ps)) @ Q@ @ g H g H I I@ 0HNd] M 0@M @g MgKgJ@ hhLJh hONh_N&_O(107 il:\\append2 95 raw-constructor 81 function-defining-form 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) (90 let 85 &key 78 constructor 30 define-boa-constructor 19 boa-constructor-p) () (let* ((il:a1464 (quote define-constructors)) (il:a1465 (quote function)) (il:a1466 "returns the forms that when evaluated, define the constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1464 il:a1465 il:a1466))) il:a1466)) create-boa-constructor il:d1 (il:l (1 ps 0 arglist) il:f 2 result-arg il:f 3 arg-list il:f 4 constructor-name) 7@A RS A Ag THgRA hhIRh h(45 il:\\append2 33 raw-constructor 23 function-defining-form 13 boa-slot-setfs 9 argument-names 4 boa-arg-list-with-initial-values) (28 let 20 boa-constructor) () 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\hhM:LLK_K_OgOdg𒿰_W^hoO@ 3O:NNOlOddoOI h_OOKf(157 ps-initial-value 154 find-slot 109 error 7 ps-all-slots 3 copy-tree) (82 &aux 73 &rest 27 &optional) ( 147 (car optional) 103 "~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 o(17 pslot-internal-accessor 4 find-slot) (10 setf) ( 21 (name)) 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)) &AHBh@I HXo@ (35 error 19 pslot-name) nil ( 31 "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:a1469 (quote raw-constructor)) (il:a1470 (quote function)) (il:a1471 "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:a1469 il:a1470 il:a1471))) il:a1471)) 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:a1472 (quote build-constructor-arglist)) (il:a1473 (quote function)) (il:a1474 "gathers the keywords and initial-values for (non BOA) constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1472 il:a1473 il:a1474))) il:a1474)) 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:a1475 (quote build-constructor-slot-setfs)) (il:a1476 (quote function)) (il:a1477 "builds the setfs that initialize the slots in a constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1475 il:a1476 il:a1477))) il:a1477)) boa-constructor-p il:d1 (il:l (0 constructor)) @inil nil () (let* ((il:a1478 (quote boa-constructor-p)) (il:a1479 (quote function)) (il:a1480 "returns t if the constructor is a By Order of Arguments constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1478 il:a1479 il:a1480))) il:a1480)) 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:a1481 (quote construct-predicate)) (il:a1482 (quote function)) (il:a1483 "returns a list of the forms (if any) defining the predicate for ps")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1481 il:a1482 il:a1483))) il:a1483)) 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:a1484 (quote ps-name-slot-position)) (il:a1485 (quote function)) (il:a1486 "returns the offset of the name slot for ps.")) (progn (cond ((fboundp (quote il:set-documentation)) ( il:set-documentation il:a1484 il:a1485 il:a1486))) il:a1486)) 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:a1487 (quote function-defining-form)) (il:a1488 (quote function)) (il:a1489 "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:a1487 il:a1488 il:a1489))) il:a1489)) 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:a1490 (quote define-copiers)) (il:a1491 (quote function)) (il:a1492 "returns the form that when evaluated, defines the copier")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1490 il:a1491 il:a1492))) il:a1492)) 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:a1493 (quote build-copier-slot-setfs)) (il:a1494 (quote function)) (il:a1495 "constructs the forms that copy each individual slot.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1493 il:a1494 il:a1495))) il:a1495)) 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:a1496 (quote build-copier-type-check)) (il:a1497 (quote function)) (il:a1498 "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:a1496 il:a1497 il:a1498 ))) il:a1498)) 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:a1499 (quote record-print-function)) (il:a1500 (quote function)) (il:a1501 "returns a list of the forms (if any) recording the print-function.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1499 il:a1500 il:a1501))) il:a1501)) (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:a1505 (quote defstruct-assert-subtypep)) (il:a1506 (quote function)) (il:a1507 "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:a1505 il:a1506 il:a1507)) ) il:a1507)) set-parsed-structure il:d1 (il:l (1 ps 0 name) il:f 0 *parsed-structures*) @dP @P dAAP c(23 acons 13 assoc 5 assoc) nil () (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