(DEFINE-FILE-INFO READTABLE "XCL" PACKAGE "LISP") (il:filecreated "30-Oct-86 14:57:51" ("compiled on " il:{eris}sources>defstruct.\;11) "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 "30-Oct-86 14:56:57" il:{eris}sources>defstruct.\;11 56203 il:|changes| il:|to:| (il:functions define-constructors build-constructor-arglist build-constructor-slot-setfs 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:| "29-Oct-86 21:54:36" il:{eris}sources>defstruct.\;10) (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:a2499 (quote defstruct)) (il:a2500 (quote il:definer-for)) (il:a2502 (quote il:structures)) ) (il:putprop il:a2499 il:a2500 il:a2502)) (let* ((il:a2503 (quote il:structures)) (il:a2504 (quote il:defined-by)) (il:a2506 (adjoin (quote defstruct) (get il:a2503 il:a2504)))) (il:putprop il:a2503 il:a2504 il:a2506)) 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:a2508 (quote il:structures)) (il:a2509 (quote il:define-types)) (il:a2510 (quote "Common Lisp structures"))) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2508 il:a2509 il:a2510))) il:a2510)) (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:a2511 (quote il:structures)) (il:a2512 il:*definition-hash-table*) (il:a2514 (make-hash-table :test (quote equal) :size 50 :rehash-size 50))) (puthash il:a2511 il:a2512 il:a2514)))) (il:setq il:filepkgtypes (adjoin (quote il:structures) il:filepkgtypes)) (let* ((il:a2515 (quote il:structures)) (il:a2516 (quote il:getdef)) (il:a2518 (quote il:\\define-type-getdef))) (il:putprop il:a2515 il:a2516 il:a2518)) (let* ((il:a2519 (quote il:structures)) (il:a2520 (quote il:deldef)) (il:a2522 (quote il:\\define-type-deldef))) (il:putprop il:a2519 il:a2520 il:a2522)) (let* ((il:a2523 (quote il:structures)) (il:a2524 (quote il:filepkgcontents)) (il:a2526 (quote il:nill ))) (il:putprop il:a2523 il:a2524 il:a2526)) (let* ((il:a2527 (quote il:structures)) (il:a2528 (quote il:undefiners)) (il:a2530 (adjoin (quote nil) (get il:a2527 il:a2528)))) (il:putprop il:a2527 il:a2528 il:a2530)) (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:a2531 (quote declare-structure)) (il:a2532 (quote function)) (il:a2533 "accomplishes all the work of declaring a structure.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2531 il:a2532 il:a2533))) il:a2533)) (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:a2554 (quote ps)) (il:a2555 (quote structure)) (il:a2556 "contains the parsed information for a SINGLE structure type")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2554 il:a2555 il:a2556))) il:a2556)) 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) D9eHkJdIvWr.8HkKdJohHkNdMuh_Hk__OdOsWt_Hk__OdOsh_Hk__OdOth_ Hk_$_"O$dO"uWrgh _&Hk_*_(O*dO(lg_,Hk_0_.O0dO.kh_2Hk_6_4O6dO4lh_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 OpagJkaJlZtagKkaKl[{agNkaNl^uagOkaOl_sagOkaOl_sagOkaOl_ragO$kaO$l_$qagO*kaO*l_*zagO0kaO0l_0{agO6kaO6l_6zagOJo@ @ 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:a2620 (quote insert-included-slot)) (il:a2621 (quote function)) (il:a2622 "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:a2620 il:a2621 il:a2622))) il:a2622)) merge-slots il:d1 (il:l (2 ps 1 super-slots 0 included-slots)) @HAAB HX(14 insert-included-slot) nil () (let* ((il:a2624 (quote merge-slots)) (il:a2625 (quote function)) (il:a2626 "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:a2624 il:a2625 il:a2626 ))) il:a2626)) 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:a2627 (quote name-slot)) (il:a2628 (quote function)) (il:a2629 "returns a parsed-slot representing the 'name' field of a structure")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2627 il:a2628 il:a2629))) il:a2629)) 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:a2630 (quote add-initial-offset-slots)) (il:a2631 (quote function)) (il:a2632 "adds parsed-slots to the local-slots to represent the initial offset.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a2630 il:a2631 il:a2632))) il:a2632)) pack-datatype-fieldspecs il:d1 (il:l (0 field-specs)) @nil nil () (let* ((il:a2633 (quote pack-datatype-fieldspecs)) (il:a2634 (quote function)) (il:a2635 "dummy")) ( progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2633 il:a2634 il:a2635)) ) il:a2635)) assign-structure-representation il:d1 (il:l (0 ps) il:f 7 *parsed-structures*) @ aHgHdg@ gg @ @ @ W o@ I @ @J KJ \L@N ggKhgJhgNhMg@ ohhh(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) (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) ( 151 "datatype included by every structure" 69 "~s is not a defined structure") (let* ((il:a2637 (quote assign-structure-representation)) (il:a2638 (quote function)) (il:a2639 "Determines the descriptors and returns a form to create the datatype at loadtime.")) (progn (cond (( fboundp (quote il:set-documentation)) (il:set-documentation il:a2637 il:a2638 il:a2639))) il:a2639)) 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:a2640 (quote define-structure-type)) (il:a2641 (quote function)) (il:a2642 "adds the structure to the common lisp type system with deftype.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2640 il:a2641 il:a2642))) il:a2642)) defstruct-slot-to-datatype-fieldspec il:d1 (il:l (0 slot)) @ (6 %structure-type-to-fieldspec 3 pslot-type) nil () (let* ((il:a2643 (quote defstruct-slot-to-datatype-fieldspec)) (il:a2644 (quote function)) (il:a2645 "given a parsed-slot returns a datatype fieldspec that will contain it.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a2643 il:a2644 il:a2645))) il:a2645)) %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:a2649 (quote assign-field-descriptors)) (il:a2650 (quote function)) (il:a2651 "assigns the field descriptors for accessing each slot of the structure")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a2649 il:a2650 il:a2651))) il:a2651)) 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:a2652 (quote define-accessors)) (il:a2653 (quote function)) (il:a2654 "returns the forms that when evaluated, define the accessors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2652 il:a2653 il:a2654))) il:a2654)) 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:a2656 (quote pslot-internal-accessor)) (il:a2657 (quote function)) (il:a2658 "returns a form which fetches slot from argument")) (progn (cond ((fboundp (quote il:set-documentation )) (il:set-documentation il:a2656 il:a2657 il:a2658))) il:a2658)) 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:a2659 (quote define-setfs)) (il:a2660 (quote function)) (il:a2661 "returns the forms that when evaluated, define the setf's for the slots.")) (progn (cond ((fboundp ( quote il:set-documentation)) (il:set-documentation il:a2659 il:a2660 il:a2661))) il:a2661)) setf-name il:d1 (il:l (0 accessor-name)) g@h (9 xcl:pack) (2 %%setf-) () (let* ((il:a2662 (quote setf-name)) (il:a2663 (quote function)) (il:a2664 "produces the name of the setf function for this accessor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2662 il:a2663 il:a2664))) il:a2664)) 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 IK@ 0HOd] M@ 0@M @g MgKgJ@ hhLJh hONh_N&_O(106 il:\\append2 94 raw-constructor 80 function-defining-form 72 %%setf-ps-standard-constructor 65 define-boa-constructor 59 boa-constructor-p 46 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) (89 let 84 &key 77 constructor 30 il:define-constructorsa0001 19 boa-constructor-p) () (let* ((il:a2665 (quote define-constructors)) (il:a2666 (quote function)) (il:a2667 "returns the forms that when evaluated, define the constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2665 il:a2666 il:a2667))) il:a2667)) 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:a2670 (quote raw-constructor)) (il:a2671 (quote function)) (il:a2672 "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:a2670 il:a2671 il:a2672))) il:a2672)) il:build-constructor-arglista0001 il:d1 (il:l (0 slot)) 3@ @ g h@ hHIHhhIhh(30 pslot-accessor 22 il:gensym 19 intern 13 symbol-name 10 pslot-name 3 pslot-initial-value) (16 keyword) () build-constructor-arglist il:d1 (il:l (0 slots)) g@ (6 mapcan) (2 il:build-constructor-arglista0001) () (let* ((il:a2673 (quote build-constructor-arglist)) (il:a2674 (quote function)) (il:a2675 "gathers the keywords and initial-values for (non BOA) constructors")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2673 il:a2674 il:a2675))) il:a2675)) il:build-constructor-slot-setfsa0001 il:d1 (il:l (0 slot) il:f 1 argument-list il:f 2 object-name il:f 3 structure-type) 7@ g@RSi @ hQQcg@RSi Hh(47 pslot-internal-accessor 19 pslot-initial-value 15 pslot-internal-accessor 3 pslot-accessor) (40 setf 8 setf) () build-constructor-slot-setfs il:d1 (il:l (2 ps 0 slots) il:p 2 argument-list il:p 1 object-name il:p 0 structure-type il:i 1 argument-list) B B Ag@ (18 mapcar 7 ps-name 3 ps-type) (14 il:build-constructor-slot-setfsa0001) () (let* ((il:a2676 (quote build-constructor-slot-setfs)) (il:a2677 (quote function)) (il:a2678 "builds the setfs that initialize the slots in a constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2676 il:a2677 il:a2678))) il:a2678)) boa-constructor-p il:d1 (il:l (0 constructor)) @inil nil () (let* ((il:a2679 (quote boa-constructor-p)) (il:a2680 (quote function)) (il:a2681 "returns t if the constructor is a By Order of Arguments constructor")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2679 il:a2680 il:a2681))) il:a2681)) 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:a2682 (quote construct-predicate)) (il:a2683 (quote function)) (il:a2684 "returns a list of the forms (if any) defining the predicate for ps")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2682 il:a2683 il:a2684))) il:a2684)) 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:a2685 (quote ps-name-slot-position)) (il:a2686 (quote function)) (il:a2687 "returns the offset of the name slot for ps.")) (progn (cond ((fboundp (quote il:set-documentation)) ( il:set-documentation il:a2685 il:a2686 il:a2687))) il:a2687)) 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:a2688 (quote function-defining-form)) (il:a2689 (quote function)) (il:a2690 "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:a2688 il:a2689 il:a2690))) il:a2690)) 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:a2691 (quote define-copiers)) (il:a2692 (quote function)) (il:a2693 "returns the form that when evaluated, defines the copier")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2691 il:a2692 il:a2693))) il:a2693)) 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:a2694 (quote build-copier-slot-setfs)) (il:a2695 (quote function)) (il:a2696 "constructs the forms that copy each individual slot.")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2694 il:a2695 il:a2696))) il:a2696)) 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:a2697 (quote build-copier-type-check)) (il:a2698 (quote function)) (il:a2699 "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:a2697 il:a2698 il:a2699 ))) il:a2699)) (proclaim (quote (special %default-print-function))) (or (boundp (quote %default-print-function)) (il:setq %default-print-function (quote default-structure-printer))) (let* ((il:a2700 (quote %default-print-function)) (il:a2701 (quote variable)) (il:a2702 "print function used when none is specified in a defstruct")) (progn (cond ((fboundp (quote il:set-documentation)) (il:set-documentation il:a2700 il:a2701 il:a2702))) il:a2702)) (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:a2706 (quote defstruct-assert-subtypep)) (il:a2707 (quote function)) (il:a2708 "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:a2706 il:a2707 il:a2708)) ) il:a2708)) (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