Changeset 4853


Ignore:
Timestamp:
11/20/03 18:42:09 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/defstruct.lisp

    r4824 r4853  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defstruct.lisp,v 1.34 2003-11-18 03:18:47 piso Exp $
     4;;; $Id: defstruct.lisp,v 1.35 2003-11-20 18:42:09 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    2929(defvar *ds-predicate*)
    3030(defvar *ds-print-function*)
     31(defvar *ds-slot-descriptions*)
    3132
    3233(defun define-constructor (constructor slots)
     
    219220        (*ds-initial-offset* nil)
    220221        (*ds-predicate* nil)
    221         (*ds-print-function* nil))
     222        (*ds-print-function* nil)
     223        (*ds-slot-descriptions* ()))
    222224    (parse-name-and-options (if (atom name-and-options)
    223225                                (list name-and-options)
     
    225227    (when (stringp (car slots))
    226228      (setf (documentation *ds-name* 'structure) (pop slots)))
     229    (dolist (slot slots)
     230      (let ((slot-description (if (atom slot)
     231                                  (list :name slot :initform nil)
     232                                  (list :name (car slot) :initform (cadr slot)))))
     233        (push slot-description *ds-slot-descriptions*)))
     234    (setf *ds-slot-descriptions* (nreverse *ds-slot-descriptions*))
    227235    `(progn
    228        (make-structure-class ',*ds-name*)
     236       (make-structure-class ',*ds-name* ',*ds-slot-descriptions*)
    229237       ,@(define-constructors slots)
    230238       ,@(define-predicate)
Note: See TracChangeset for help on using the changeset viewer.