Changeset 4203


Ignore:
Timestamp:
10/05/03 18:27:56 (19 years ago)
Author:
piso
Message:

:COPIER option.

File:
1 edited

Legend:

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

    r4200 r4203  
    22;;;
    33;;; Copyright (C) 2003 Peter Graves
    4 ;;; $Id: defstruct.lisp,v 1.25 2003-10-05 15:36:54 piso Exp $
     4;;; $Id: defstruct.lisp,v 1.26 2003-10-05 18:27:56 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    9090
    9191(defun define-copier ()
    92   (let ((copier (intern (concatenate 'string "COPY-" (symbol-name *ds-name*)))))
    93     `((setf (fdefinition ',copier) #'copy-structure))))
     92  (when *ds-copier*
     93    `((setf (fdefinition ',*ds-copier*) #'copy-structure))))
    9494
    9595(defun parse-1-option (option)
     
    115115          (push (list name arglist) *ds-constructors*))
    116116         (2))))
     117    (:copier
     118     (let* ((args (cdr option))
     119            (numargs (length args)))
     120       (when (= numargs 1)
     121          (setf *ds-copier* (cadr args)))))
    117122    (:predicate
    118123     (when (= (length option) 2)
     
    124129  (setf *ds-name* (car name-and-options))
    125130  (setf *ds-conc-name* (make-symbol (concatenate 'string (symbol-name *ds-name*) "-")))
     131  (setf *ds-copier* (intern (concatenate 'string "COPY-" (symbol-name *ds-name*))))
    126132  (setf *ds-predicate* (concatenate 'string (symbol-name *ds-name*) "-P"))
    127133  (let ((options (cdr name-and-options)))
Note: See TracChangeset for help on using the changeset viewer.