Changeset 4009


Ignore:
Timestamp:
09/22/03 22:56:12 (19 years ago)
Author:
piso
Message:

Support :PREDICATE option.

File:
1 edited

Legend:

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

    r4008 r4009  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defstruct.lisp,v 1.20 2003-09-22 17:46:26 piso Exp $
     4;;; $Id: defstruct.lisp,v 1.21 2003-09-22 22:56:12 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    3939
    4040(defun define-predicate ()
    41   (let ((pred (intern (concatenate 'string (symbol-name *ds-name*) "-P"))))
    42     `((defun ,pred (object)
    43         (typep object ',*ds-name*)))))
     41  (when *ds-predicate*
     42    (let ((pred (intern *ds-predicate*)))
     43      `((defun ,pred (object)
     44          (typep object ',*ds-name*))))))
     45
    4446
    4547(defmacro get-slot-accessor (slot)
     
    8890                              (make-symbol (string (cadr option))))))
    8991    (:constructor
    90      (when (= (length (cdr option)) 1)
     92     (when (= (length option) 2)
    9193       (if (null (cadr option))
    9294           (setf *ds-constructor* nil)
    93            (setf *ds-constructor* (symbol-name (cadr option))))))))
     95           (setf *ds-constructor* (symbol-name (cadr option))))))
     96    (:predicate
     97     (when (= (length option) 2)
     98       (if (null (cadr option))
     99           (setf *ds-predicate* nil)
     100           (setf *ds-predicate* (symbol-name (cadr option))))))))
    94101
    95102(defun parse-name-and-options (name-and-options)
     
    97104  (setf *ds-conc-name* (make-symbol (concatenate 'string (symbol-name *ds-name*) "-")))
    98105  (setf *ds-constructor* (concatenate 'string "MAKE-" (symbol-name *ds-name*)))
     106  (setf *ds-predicate* (concatenate 'string (symbol-name *ds-name*) "-P"))
    99107  (let ((options (cdr name-and-options)))
    100108    (dolist (option options)
Note: See TracChangeset for help on using the changeset viewer.