(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") (il:filecreated "24-Oct-86 14:00:37" ("compiled on " il:{eris}zebra>defstruct.\;31) "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 13:59:36" il:{eris}zebra>defstruct.\;31 54245 il:|changes| il:|to:| (il:vars il:defstructcoms) (il:functions defstruct-parse-options define-boa-constructor define-constructors find-slot argument-names boa-arg-list-with-initial-values boa-slot-setfs %structure-type-to-fieldspec set-parsed-structure create-boa-constructor assign-structure-representation ensure-consistent-ps defstruct-slot-to-datatype-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: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 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: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:a1872 (quote il:structures)) (il:a1873 il:*definition-hash-table*) (il:a1875 (make-hash-table (quote :test) (quote equal) (quote :size) 50 (quote :rehash-size) 50))) (puthash il:a1872 il:a1873 il:a1875)))) (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:a1876 (quote declare-structure)) (il:a1877 (quote function)) (il:a1878 "accomplishes all the work of declaring a structure.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1876 il:a1877 il:a1878))) il:a1878)) (let* ((il:a1883 (quote ps)) (il:a1884 (quote structure)) (il:a1885 "contains the parsed information for a SINGLE structure type")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1883 il:a1884 il:a1885))) il:a1885)) 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:a1943 (quote insert-included-slot)) (il:a1944 (quote function)) (il:a1945 "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:a1943 il:a1944 il:a1945))) il:a1945)) merge-slots il:d1 (il:l (2 ps 1 super-slots 0 included-slots)) @HAAB HX(14 insert-included-slot) nil () (let* ((il:a1947 (quote merge-slots)) (il:a1948 (quote function)) (il:a1949 "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:a1947 il:a1948 il:a1949 ))) il:a1949)) 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:a1950 (quote name-slot)) (il:a1951 (quote function)) (il:a1952 "returns a parsed-slot representing the 'name' field of a structure")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1950 il:a1951 il:a1952))) il:a1952)) 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:a1953 (quote add-initial-offset-slots)) (il:a1954 (quote function)) (il:a1955 "adds parsed-slots to the local-slots to represent the initial offset.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1953 il:a1954 il:a1955))) il:a1955)) pack-datatype-fieldspecs il:d1 (il:l (0 field-specs)) @nil nil () (let* ((il:a1956 (quote pack-datatype-fieldspecs)) (il:a1957 (quote function)) (il:a1958 "dummy")) ( progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1956 il:a1957 il:a1958)) ) il:a1958)) 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:a1960 (quote assign-structure-representation)) (il:a1961 (quote function)) (il:a1962 "Determines the descriptors and returns a form to create the datatype at loadtime.")) (progn (cond (( fboundp (quote il:set-documentation)) (il:set-documentation il:a1960 il:a1961 il:a1962))) il:a1962)) 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:a1963 (quote define-structure-type)) (il:a1964 (quote function)) (il:a1965 "adds the structure to the common lisp type system with deftype.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1963 il:a1964 il:a1965))) il:a1965)) defstruct-slot-to-datatype-fieldspec il:d1 (il:l (0 slot)) @ (6 %structure-type-to-fieldspec 3 pslot-type) nil () (let* ((il:a1966 (quote defstruct-slot-to-datatype-fieldspec)) (il:a1967 (quote function)) (il:a1968 "given a parsed-slot returns a datatype fieldspec that will contain it.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1966 il:a1967 il:a1968))) il:a1968)) %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:a1972 (quote assign-field-descriptors)) (il:a1973 (quote function)) (il:a1974 "assigns the field descriptors for accessing each slot of the structure")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1972 il:a1973 il:a1974))) il:a1974)) 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:a1975 (quote define-accessors)) (il:a1976 (quote function)) (il:a1977 "returns the forms that when evaluated, define the accessors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1975 il:a1976 il:a1977))) il:a1977)) 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:a1979 (quote pslot-internal-accessor)) (il:a1980 (quote function)) (il:a1981 "returns a form which fetches slot from argument")) (progn (cond ((fboundp (quote il:set-documentation )) (il:set-documentation il:a1979 il:a1980 il:a1981))) il:a1981)) 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:a1982 (quote define-setfs)) (il:a1983 (quote function)) (il:a1984 "returns the forms that when evaluated, define the setf's for the slots.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a1982 il:a1983 il:a1984))) il:a1984)) setf-name il:d1 (il:l (0 accessor-name)) g@h (9 xcl:pack) (2 %%setf-) () (let* ((il:a1985 (quote setf-name)) (il:a1986 (quote function)) (il:a1987 "produces the name of the setf function for this accessor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1985 il:a1986 il:a1987))) il:a1987)) 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:a1988 (quote define-constructors)) (il:a1989 (quote function)) (il:a1990 "returns the forms that when evaluated, define the constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1988 il:a1989 il:a1990))) il:a1990)) 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:a1993 (quote raw-constructor)) (il:a1994 (quote function)) (il:a1995 "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:a1993 il:a1994 il:a1995))) il:a1995)) 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:a1996 (quote build-constructor-arglist)) (il:a1997 (quote function)) (il:a1998 "gathers the keywords and initial-values for (non BOA) constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1996 il:a1997 il:a1998))) il:a1998)) 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:a1999 (quote build-constructor-slot-setfs)) (il:a2000 (quote function)) (il:a2001 "builds the setfs that initialize the slots in a constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a1999 il:a2000 il:a2001))) il:a2001)) boa-constructor-p il:d1 (il:l (0 constructor)) @inil nil () (let* ((il:a2002 (quote boa-constructor-p)) (il:a2003 (quote function)) (il:a2004 "returns t if the constructor is a By Order of Arguments constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2002 il:a2003 il:a2004))) il:a2004)) 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:a2005 (quote construct-predicate)) (il:a2006 (quote function)) (il:a2007 "returns a list of the forms (if any) defining the predicate for ps")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2005 il:a2006 il:a2007))) il:a2007)) 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:a2008 (quote ps-name-slot-position)) (il:a2009 (quote function)) (il:a2010 "returns the offset of the name slot for ps.")) (progn (cond ((fboundp (quote il:set-documentation)) ( il:set-documentation il:a2008 il:a2009 il:a2010))) il:a2010)) 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:a2011 (quote function-defining-form)) (il:a2012 (quote function)) (il:a2013 "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:a2011 il:a2012 il:a2013))) il:a2013)) 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:a2014 (quote define-copiers)) (il:a2015 (quote function)) (il:a2016 "returns the form that when evaluated, defines the copier")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2014 il:a2015 il:a2016))) il:a2016)) 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:a2017 (quote build-copier-slot-setfs)) (il:a2018 (quote function)) (il:a2019 "constructs the forms that copy each individual slot.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2017 il:a2018 il:a2019))) il:a2019)) 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:a2020 (quote build-copier-type-check)) (il:a2021 (quote function)) (il:a2022 "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:a2020 il:a2021 il:a2022 ))) il:a2022)) 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:a2023 (quote record-print-function)) (il:a2024 (quote function)) (il:a2025 "returns a list of the forms (if any) recording the print-function.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2023 il:a2024 il:a2025))) il:a2025)) (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:a2029 (quote defstruct-assert-subtypep)) (il:a2030 (quote function)) (il:a2031 "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:a2029 il:a2030 il:a2031)) ) il:a2031)) 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