Changeset 4868


Ignore:
Timestamp:
11/22/03 16:32:39 (18 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r4867 r4868  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defstruct.lisp,v 1.41 2003-11-22 02:49:10 piso Exp $
     4;;; $Id: defstruct.lisp,v 1.42 2003-11-22 16:32:39 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    100100(defvar *dd-slots*)
    101101
    102 (defun define-constructor (constructor)
     102(defun define-keyword-constructor (constructor)
    103103  (let* ((constructor-name (intern (car constructor)))
    104104         (keys ())
     
    131131               (%make-structure ',*dd-name* (list ,@elements))))))))
    132132
     133(defun define-boa-constructor (constructor)
     134  )
     135
    133136(defun default-constructor-name ()
    134137  (concatenate 'string "MAKE-" (symbol-name *dd-name*)))
     
    139142        (dolist (constructor *dd-constructors*)
    140143          (when (car constructor)
    141             (setf results (nconc results (define-constructor constructor)))))
     144            (setf results (nconc results
     145                                 (if (cadr constructor)
     146                                     (define-boa-constructor constructor)
     147                                     (define-keyword-constructor constructor))))))
    142148        results)
    143       (define-constructor (cons (default-constructor-name) nil))))
     149      (define-keyword-constructor (cons (default-constructor-name) nil))))
    144150
    145151(defun name-index ()
Note: See TracChangeset for help on using the changeset viewer.