/[cmucl]/src/code/defstruct.lisp
ViewVC logotype

Contents of /src/code/defstruct.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8.1.3 - (hide annotations) (vendor branch)
Wed Aug 15 17:49:12 1990 UTC (23 years, 8 months ago) by wlott
Changes since 1.8.1.2: +2 -2 lines
Generate setf functions with the args in the right order.
1 ram 1.1 ;;; -*- Log: code.log; Package: C -*-
2     ;;;
3     ;;; **********************************************************************
4     ;;; This code was written as part of the Spice Lisp project at
5     ;;; Carnegie-Mellon University, and has been placed in the public domain.
6     ;;; If you want to use this code or any part of Spice Lisp, please contact
7     ;;; Scott Fahlman (FAHLMAN@CMUC).
8     ;;; **********************************************************************
9     ;;;
10 wlott 1.8.1.3 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/code/defstruct.lisp,v 1.8.1.3 1990/08/15 17:49:12 wlott Exp $
11 wlott 1.8.1.1 ;;;
12 ram 1.1 ;;; Defstruct structure definition package (Mark II).
13     ;;; Written by Skef Wholey and Rob MacLachlan.
14     ;;;
15     (in-package 'c)
16     (export '(lisp::defstruct) "LISP")
17    
18 wlott 1.8.1.2 ;;; Note: STRUCTURIFY is defined in struct.lisp. It converts a simple-vector
19     ;;; into a structure.
20 ram 1.1
21    
22     ;;; This version of Defstruct is implemented using Defstruct, and is free of
23     ;;; Maclisp compatability nonsense. For bootstrapping, you're on your own.
24    
25     (defun print-defstruct-description (structure stream depth)
26     (declare (ignore depth))
27     (format stream "#<Defstruct-Description for ~S>" (dd-name structure)))
28    
29     ;;; DSD-Name -- Internal
30     ;;;
31     ;;; Return the the name of a defstruct slot as a symbol. We store it
32     ;;; as a string to avoid creating lots of worthless symbols at load time.
33     ;;;
34     (defun dsd-name (dsd)
35     (intern (string (dsd-%name dsd)) (symbol-package (dsd-accessor dsd))))
36    
37     (defun print-defstruct-slot-description (structure stream depth)
38     (declare (ignore depth))
39     (format stream "#<Defstruct-Slot-Description for ~S>" (dsd-name structure)))
40 ram 1.5
41    
42 ram 1.1
43     ;;; The legendary macro itself.
44    
45     ;;; ### Bootstrap hack...
46     ;;; Install this definition only into the new compiler's environment so that we
47     ;;; don't break the bootstrap environment.
48     ;;;
49     (compiler-let ((lisp::*bootstrap-defmacro* t))
50    
51     (defmacro defstruct (name-and-options &rest slot-descriptions)
52     "Defstruct {Name | (Name Option*)} {Slot | (Slot [Default] {Key Value}*)}
53     Define the structure type Name. See the manual for details."
54     (let* ((defstruct (parse-name-and-options name-and-options))
55     (name (dd-name defstruct)))
56     (parse-slot-descriptions defstruct slot-descriptions)
57     (if (eq (dd-type defstruct) 'structure)
58     `(progn
59     (%compiler-defstruct ',defstruct)
60     ,@(define-constructor defstruct)
61     ,@(define-boa-constructors defstruct)
62    
63     ;;
64     ;; So the print function is in the right lexical environment, and
65     ;; can be compiled...
66     (let ((new ',defstruct))
67 ram 1.4 ,@(let ((pf (dd-print-function defstruct)))
68     (when pf
69     `((setf (info type printer ',name)
70     ,(if (symbolp pf)
71     `',pf
72     `#',pf)))))
73 ram 1.1 (%defstruct new))
74     ',name)
75     `(progn
76     (eval-when (compile load eval)
77     (setf (info type kind ',name) nil)
78     (setf (info type structure-info ',name) ',defstruct))
79     ,@(define-constructor defstruct)
80     ,@(define-boa-constructors defstruct)
81     ,@(define-predicate defstruct)
82     ,@(define-accessors defstruct)
83     ,@(define-copier defstruct)
84     ',name))))
85    
86     ); Compiler-Let
87    
88    
89     ;;;; Parsing:
90    
91     (defun parse-name-and-options (name-and-options)
92     (if (atom name-and-options)
93     (setq name-and-options (list name-and-options)))
94     (do* ((options (cdr name-and-options) (cdr options))
95     (name (car name-and-options))
96 ram 1.6 (print-function nil)
97 ram 1.5 (pf-supplied-p)
98 ram 1.1 (conc-name (concat-pnames name '-))
99     (constructor (concat-pnames 'make- name))
100     (saw-constructor)
101     (boa-constructors '())
102     (copier (concat-pnames 'copy- name))
103     (predicate (concat-pnames name '-p))
104     (include)
105     (saw-type)
106     (type 'structure)
107     (saw-named)
108     (offset 0))
109     ((null options)
110     (make-defstruct-description
111     :name name
112     :conc-name conc-name
113     :constructor constructor
114     :boa-constructors boa-constructors
115     :copier copier
116     :predicate predicate
117     :include include
118     :print-function print-function
119     :type type
120     :lisp-type (cond ((eq type 'structure) 'simple-vector)
121     ((eq type 'vector) 'simple-vector)
122     ((eq type 'list) 'list)
123     ((and (listp type) (eq (car type) 'vector))
124     (cons 'simple-array (cdr type)))
125     (t (error "~S is a bad :TYPE for Defstruct." type)))
126     :named (if saw-type saw-named t)
127     :offset offset))
128     (if (atom (car options))
129     (case (car options)
130     (:constructor (setq saw-constructor t
131     constructor (concat-pnames 'make- name)))
132     (:copier)
133     (:predicate)
134     (:named (setq saw-named t))
135     (t (error "The Defstruct option ~S cannot be used with 0 arguments."
136     (car options))))
137     (let ((option (caar options))
138     (args (cdar options)))
139     (case option
140     (:conc-name (setq conc-name (car args)))
141     (:constructor (cond ((cdr args)
142     (unless saw-constructor
143     (setq constructor nil))
144     (push args boa-constructors))
145     (t
146     (setq saw-constructor t)
147 ram 1.5 (setq constructor
148     (or (car args)
149     (concat-pnames 'make- name))))))
150 ram 1.1 (:copier (setq copier (car args)))
151     (:predicate (setq predicate (car args)))
152 ram 1.5 (:include
153     (setf include args)
154     (let* ((name (car include))
155     (included-structure
156 ram 1.7 (info type structure-info name))
157 ram 1.5 (included-print-function
158     (if included-structure
159     (dd-print-function included-structure))))
160     (unless included-structure
161     (error "Cannot find description of structure ~S to use for ~
162     inclusion."
163     name))
164     (unless pf-supplied-p
165     (setf print-function included-print-function))))
166     (:print-function
167 ram 1.6 (setf print-function (car args))
168 ram 1.5 (setf pf-supplied-p t))
169     (:type (setf saw-type t type (car args)))
170 ram 1.1 (:named (error "The Defstruct option :NAMED takes no arguments."))
171 ram 1.5 (:initial-offset (setf offset (car args)))
172 ram 1.1 (t (error "~S is an unknown Defstruct option." option)))))))
173 ram 1.5
174    
175 ram 1.1
176 ram 1.5 ;;;; Stuff to parse slot descriptions.
177    
178     ;;; PARSE-SLOT-DESCRIPTIONS parses the slot descriptions (surprise) and does
179 ram 1.1 ;;; any structure inclusion that needs to be done.
180 ram 1.5 ;;;
181 ram 1.1 (defun parse-slot-descriptions (defstruct slots)
182     ;; First strip off any doc string and stash it in the Defstruct.
183     (when (stringp (car slots))
184     (setf (dd-doc defstruct) (car slots))
185     (setq slots (cdr slots)))
186     ;; Then include stuff. We add unparsed items to the start of the Slots.
187     (when (dd-include defstruct)
188     (let* ((included-name (car (dd-include defstruct)))
189     (included-thing (info type structure-info included-name))
190     (modified-slots (cdr (dd-include defstruct))))
191     (unless included-thing
192     (error "Cannot find description of structure ~S to use for inclusion."
193     included-name))
194     (setf (dd-includes defstruct)
195     (cons (dd-name included-thing) (dd-includes included-thing)))
196     (setf (dd-offset defstruct) (dd-offset included-thing))
197     (do* ((islots (mapcar #'(lambda (slot)
198     `(,(dsd-name slot) ,(dsd-default slot)
199     :type ,(dsd-type slot)
200     :read-only ,(dsd-read-only slot)))
201     (dd-slots included-thing)))
202     (islots* islots (cdr islots*)))
203     ((null islots*)
204     (setq slots (nconc islots slots)))
205     (let* ((islot (car islots*))
206     (modifiee (find (car islot) modified-slots
207     :key #'(lambda (x) (if (atom x) x (car x)))
208     :test #'string=)))
209     (when modifiee
210     (cond ((symbolp modifiee)
211     ;; If it's just a symbol, nilify the default.
212     (setf (cadr islot) nil))
213     ((listp modifiee)
214     ;; If it's a list, parse new defaults and options.
215     (setf (cadr islot) (cadr modifiee))
216     (when (cddr modifiee)
217     (do ((options (cddr modifiee) (cddr options)))
218     ((null options))
219     (case (car options)
220     (:type
221     (setf (cadddr islot) (cadr options)))
222     (:read-only
223     (setf (cadr (cddddr islot)) (cadr options)))
224     (t
225     (error "Bad option in included slot spec: ~S."
226     (car options)))))))))))))
227     ;; Finally parse the slots into Slot-Description objects.
228     (do ((slots slots (cdr slots))
229 ram 1.5 (index (+ (dd-offset defstruct) (if (dd-named defstruct) 1 0))
230     (1+ index))
231     (descriptions ()))
232 ram 1.1 ((null slots)
233     (setf (dd-length defstruct) index)
234     (setf (dd-slots defstruct) (nreverse descriptions)))
235 ram 1.5 (let* ((slot (car slots))
236     (name (if (atom slot) slot (car slot))))
237     (when (keywordp name)
238     (warn "Keyword slot name indicates possible syntax error in DEFSTRUCT ~
239     -- ~S."
240     name))
241 ram 1.1 (push
242     (if (atom slot)
243 ram 1.5 (make-defstruct-slot-description
244     :%name (string name)
245     :index index
246     :accessor (concat-pnames (dd-conc-name defstruct) name)
247     :type t)
248 ram 1.1 (do ((options (cddr slot) (cddr options))
249     (default (cadr slot))
250     (type t)
251     (read-only nil))
252     ((null options)
253     (make-defstruct-slot-description
254     :%name (string name)
255     :index index
256     :accessor (concat-pnames (dd-conc-name defstruct) name)
257     :default default
258     :type type
259     :read-only read-only))
260     (case (car options)
261     (:type (setq type (cadr options)))
262     (:read-only (setq read-only (cadr options))))))
263     descriptions))))
264    
265    
266    
267     ;;;; Default structure access and copiers:
268     ;;;
269     ;;; In the normal case of structures that have a real type (i.e. no :Type
270     ;;; option was specified), we want to optimize things for space as well as
271     ;;; speed, since there can be thousands of defined slot accesors.
272     ;;;
273     ;;; What we do is defined the accessors and copier as closures over
274     ;;; general-case code. Since the compiler will normally open-code accesors,
275     ;;; the (minor) efficiency penalty is not a concern.
276    
277     ;;; Typep-To-Structure -- Internal
278     ;;;
279     ;;; Return true if Obj is an object of the structure type specified by Info.
280     ;;; This is called by the accessor closures, which have a handle on the type's
281     ;;; Defstruct-Description.
282     ;;;
283 wlott 1.8.1.1 #+new-compiler
284 ram 1.1 (proclaim '(inline typep-to-structure))
285 wlott 1.8.1.1 #+new-compiler
286 ram 1.1 (defun typep-to-structure (obj info)
287     (declare (type defstruct-description info) (inline member))
288     (and (structurep obj)
289 wlott 1.8.1.1 (let ((name (%primitive structure-ref obj 0)))
290 ram 1.1 (or (eq name (dd-name info))
291     (member name (dd-included-by info) :test #'eq)))))
292    
293     #+new-compiler
294     ;;; %Defstruct -- Internal
295     ;;;
296     ;;; Do miscellaneous load-time actions for the structure described by Info.
297     ;;; Define setters, accessors, copier, predicate, documentation, instantiate
298     ;;; definition in load-time env. This is only called for default structures.
299     ;;;
300     (defun %defstruct (info)
301     (declare (type defstruct-description info))
302 ram 1.3 (setf (info type defined-structure-info (dd-name info)) info)
303    
304 ram 1.1 (dolist (slot (dd-slots info))
305     (let ((dsd slot))
306     (setf (symbol-function (dsd-accessor slot))
307     #'(lambda (structure)
308     (declare (optimize (speed 3) (safety 0)))
309     (unless (typep-to-structure structure info)
310     (error "Structure for accessor ~S is not a ~S:~% ~S"
311     (dsd-accessor dsd) (dd-name info) structure))
312 wlott 1.8.1.1 (%primitive structure-index-ref structure (dsd-index dsd))))
313 ram 1.1
314     (unless (dsd-read-only slot)
315     (setf (fdefinition `(setf ,(dsd-accessor slot)))
316     #'(lambda (structure new-value)
317     (declare (optimize (speed 3) (safety 0)))
318     (unless (typep-to-structure structure info)
319     (error "Structure for setter ~S is not a ~S:~% ~S"
320     `(setf ,(dsd-accessor dsd)) (dd-name info)
321     structure))
322     (unless (typep new-value (dsd-type dsd))
323     (error "New-Value for setter ~S is not a ~S:~% ~S."
324     `(setf ,(dsd-accessor dsd)) (dsd-type dsd)
325     new-value))
326 wlott 1.8.1.1 (%primitive structure-index-set structure (dsd-index dsd)
327 ram 1.1 new-value))))))
328    
329     (when (dd-predicate info)
330     (setf (symbol-function (dd-predicate info))
331     #'(lambda (object)
332     (declare (optimize (speed 3) (safety 0)))
333     (if (typep-to-structure object info) t nil))))
334    
335     (when (dd-copier info)
336     (setf (symbol-function (dd-copier info))
337     #'(lambda (structure)
338     (declare (optimize (speed 3) (safety 0)))
339     (unless (typep-to-structure structure info)
340     (error "Structure for copier ~S is not a ~S:~% ~S"
341     (dd-copier info) (dd-name info) structure))
342    
343     (let ((len (dd-length info)))
344     (declare (fixnum len))
345     (do ((i 1 (1+ i))
346     (res (%primitive alloc-g-vector len nil)))
347     ((= i len)
348 wlott 1.8.1.1 (%primitive structure-set res (dd-name info) 0)
349 ram 1.1 (structurify res))
350     (declare (fixnum i))
351 wlott 1.8.1.1 (%primitive structure-index-set res i
352     (%primitive structure-index-ref structure i)))))))
353 ram 1.1 (when (dd-doc info)
354     (setf (documentation (dd-name info) 'type) (dd-doc info))))
355    
356    
357     ;;; Define-Accessors returns a list of function definitions for accessing and
358     ;;; setting the slots of the a typed Defstruct. The functions are proclaimed
359     ;;; to be inline, and the types of their arguments and results are declared as
360     ;;; well. We count on the compiler to do clever things with Elt.
361    
362     (defun define-accessors (defstruct)
363     (do ((slots (dd-slots defstruct) (cdr slots))
364     (stuff '())
365     (type (dd-lisp-type defstruct)))
366     ((null slots) stuff)
367     (let* ((slot (car slots))
368     (name (dsd-accessor slot))
369     (index (dsd-index slot))
370     (slot-type (dsd-type slot)))
371     (push
372     `(progn
373     (proclaim '(inline ,name (setf ,name)))
374     (defun ,name (structure)
375     (declare (type ,type structure))
376     (the ,slot-type (elt structure ,index)))
377     ,@(unless (dsd-read-only slot)
378 wlott 1.8.1.3 `((defun (setf ,name) (new-value structure)
379 ram 1.1 (declare (type ,type structure) (type ,slot-type new-value))
380     (setf (elt structure ,index) new-value)))))
381     stuff))))
382    
383    
384     ;;; Define-Constructor returns a definition for the constructor function of the
385     ;;; given Defstruct. If the structure is implemented as a vector and is named,
386     ;;; we structurify it. If the structure is a vector of some specialized type,
387     ;;; we can't use the Vector function.
388     ;;;
389     ;;; If we are defining safe accessors, we also check the types of the values to
390     ;;; make sure that they are legal.
391     ;;;
392     (defun define-constructor (defstruct)
393     (let ((name (dd-constructor defstruct)))
394     (when name
395     (let* ((initial-cruft
396     (if (dd-named defstruct)
397     (make-list (1+ (dd-offset defstruct))
398     :initial-element `',(dd-name defstruct))
399     (make-list (dd-offset defstruct))))
400     (slots (dd-slots defstruct))
401     (names (mapcar #'dsd-name slots))
402     (args (mapcar #'(lambda (slot)
403     `(,(dsd-name slot) ,(dsd-default slot)))
404     slots)))
405     `((defun ,name ,(if args `(&key ,@args))
406     (declare
407     ,@(mapcar #'(lambda (slot)
408     `(type ,(dsd-type slot) ,(dsd-name slot)))
409     slots))
410     ,(case (dd-type defstruct)
411     (list
412     `(list ,@initial-cruft ,@names))
413     (structure
414     `(truly-the ,(dd-name defstruct)
415     (structurify
416     (vector ,@initial-cruft ,@names))))
417     (vector
418     `(vector ,@initial-cruft ,@names))
419     (t
420     (do ((sluts slots (cdr sluts))
421     (sets '())
422     (temp (gensym)))
423     ((null sluts)
424     `(let ((,temp (make-array
425     ,(dd-length defstruct)
426     :element-type
427     ',(cadr (dd-lisp-type defstruct)))))
428     ,@(when (dd-named defstruct)
429     `(setf (aref ,temp ,(dd-offset defstruct))
430     ',(dd-name defstruct)))
431     ,@sets
432     ,temp))
433     (let ((slot (car sluts)))
434     (push `(setf (aref ,temp ,(dsd-index slot))
435     ,(dsd-name slot))
436     sets)))))))))))
437 ram 1.5
438    
439 ram 1.1
440 ram 1.5 ;;;; Support for By-Order-Argument Constructors.
441    
442     ;;; FIND-LEGAL-SLOT -- Internal
443 ram 1.1 ;;;
444     ;;; Given a defstruct description and a slot name, return the corresponding
445     ;;; slot if it exists, or signal an error if not.
446     ;;;
447     (defun find-legal-slot (defstruct name)
448     (or (find name (dd-slots defstruct) :key #'dsd-name :test #'string=)
449     (error "~S is not a defined slot name in the ~S structure."
450     name (dd-name defstruct))))
451    
452 ram 1.5
453     ;;; Define-Boa-Constructors defines positional constructor functions. We
454     ;;; generate code to set each variable not specified in the arglist to the
455     ;;; default given in the Defstruct. We just slap required args in, as with
456     ;;; rest args and aux args. Optionals are treated a little differently. Those
457     ;;; that aren't supplied with a default in the arg list are mashed so that
458     ;;; their default in the arglist is the corresponding default from the
459     ;;; Defstruct.
460 ram 1.1 ;;;
461     (defun define-boa-constructors (defstruct)
462     (do* ((boas (dd-boa-constructors defstruct) (cdr boas))
463     (name (car (car boas)) (car (car boas)))
464     (args (copy-list (cadr (car boas))) (copy-list (cadr (car boas))))
465     (slots (dd-slots defstruct) (dd-slots defstruct))
466     (slots-in-arglist '() '())
467     (defuns '()))
468     ((null boas) defuns)
469     ;; Find the slots in the arglist and hack the defaultless optionals.
470     (do ((args args (cdr args))
471     (arg-kind 'required))
472     ((null args))
473     (let ((arg (car args)))
474 ram 1.5 (cond ((not (atom arg))
475     (push (find-legal-slot defstruct (car arg)) slots-in-arglist))
476 wlott 1.8.1.1 ((member arg '(&optional &rest &aux &key) :test #'eq)
477 ram 1.5 (setq arg-kind arg))
478     (t
479     (case arg-kind
480     ((required &rest &aux)
481     (push (find-legal-slot defstruct arg) slots-in-arglist))
482     ((&optional &key)
483     (let ((dsd (find-legal-slot defstruct arg)))
484     (push dsd slots-in-arglist)
485     (rplaca args (list arg (dsd-default dsd))))))))))
486 ram 1.1
487 ram 1.5 ;; Then make a list that can be used with a (list ...) or (vector...).
488 ram 1.1 (let ((initial-cruft
489     (if (dd-named defstruct)
490     (make-list (1+ (dd-offset defstruct))
491     :initial-element `',(dd-name defstruct))
492     (make-list (dd-offset defstruct))))
493     (thing (mapcar #'(lambda (slot)
494 wlott 1.8.1.1 (if (member slot slots-in-arglist
495     :test #'eq)
496 ram 1.1 (dsd-name slot)
497     (dsd-default slot)))
498     slots)))
499     (push
500     `(defun ,name ,args
501     (declare
502     ,@(mapcar #'(lambda (slot)
503     `(type ,(dsd-type slot) ,(dsd-name slot)))
504     slots-in-arglist))
505     ,(case (dd-type defstruct)
506     (list
507     `(list ,@initial-cruft ,@thing))
508     (structure
509     `(truly-the ,(dd-name defstruct)
510     (structurify (vector ,@initial-cruft ,@thing))))
511     (vector
512     `(vector ,@initial-cruft ,@thing))
513     (t
514     (do ((things thing (cdr things))
515     (index 0 (1+ index))
516     (sets '())
517     (temp (gensym)))
518     ((null things)
519     `(let ((,temp (make-array
520     ,(dd-length defstruct)
521     :element-type
522     ',(cadr (dd-lisp-type defstruct)))))
523     ,@(when (dd-named defstruct)
524     `(setf (aref ,temp ,(dd-offset defstruct))
525     ',(dd-name defstruct)))
526     ,@sets
527     ,temp))
528     (push `(setf (aref ,temp index) ,(car things))
529     sets)))))
530     defuns))))
531    
532     ;;; Define-Copier returns the definition for a copier function of a typed
533     ;;; Defstruct if one is desired.
534    
535     (defun define-copier (defstruct)
536     (when (dd-copier defstruct)
537     `((defun ,(dd-copier defstruct) (structure)
538     (declare (type ,(dd-lisp-type defstruct) structure))
539     (subseq structure 0 ,(dd-length defstruct))))))
540    
541    
542     ;;; Define-Predicate returns a definition for a predicate function if one is
543     ;;; desired. This is only called for typed structures, since the default
544     ;;; structure predicate is implemented as a closure.
545    
546 ram 1.7 (defun define-predicate (defstruct)
547 ram 1.1 (let ((name (dd-name defstruct))
548     (pred (dd-predicate defstruct)))
549     (when (and pred (dd-named defstruct))
550     (let ((ltype (dd-lisp-type defstruct)))
551     `((defun ,pred (object)
552     (and (typep object ',ltype)
553     (eq (elt (the ,ltype object) ,(dd-offset defstruct))
554     ',name))))))))
555    
556    
557     ;;; Structure-Predicate -- Internal
558     ;;;
559     ;;; The typep transform in typetran calls this function when it encounters
560     ;;; an unknown symbol type specifier. If the referred-to type is in fact a
561     ;;; structure type that has a predicate, then we open-code the normal case of
562     ;;; an exact match, and otherwise call the predicate.
563     ;;;
564     (defun structure-predicate (object type)
565     (let ((def (info type structure-info type)))
566     (if (and def (eq (dd-type def) 'structure) (dd-predicate def))
567     `(and (structurep ,object)
568 wlott 1.8.1.1 (if (eq (%primitive structure-ref ,object 0) ',type)
569 ram 1.8 t
570 ram 1.1 (,(dd-predicate def) ,object)))
571     `(lisp::structure-typep ,object ',type))))
572    
573    
574     ;;; Random sorts of stuff.
575    
576     (defun default-structure-print (structure stream depth)
577     (declare (ignore depth))
578     (write-string "#S(" stream)
579     (prin1 (svref structure 0) stream)
580     (do ((index 1 (1+ index))
581     (length (length structure))
582 ram 1.3 (slots (dd-slots (info type defined-structure-info (svref structure 0)))
583 ram 1.1 (cdr slots)))
584     ((or (= index length)
585     (and *print-length*
586     (= index *print-length*)))
587     (if (= index length)
588     (write-string ")" stream)
589     (write-string "...)" stream)))
590     (write-char #\space stream)
591     (prin1 (dsd-name (car slots)) stream)
592     (write-char #\space stream)
593     (prin1 (svref structure index) stream)))

  ViewVC Help
Powered by ViewVC 1.1.5