1 ;;;; Copyright (C) 1999, 2000, 2005, 2006 Free Software Foundation, Inc.
3 ;;;; This program is free software; you can redistribute it and/or modify
4 ;;;; it under the terms of the GNU General Public License as published by
5 ;;;; the Free Software Foundation; either version 2, or (at your option)
6 ;;;; any later version.
8 ;;;; This program is distributed in the hope that it will be useful,
9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 ;;;; GNU General Public License for more details.
13 ;;;; You should have received a copy of the GNU General Public License
14 ;;;; along with this software; see the file COPYING. If not, write to
15 ;;;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
16 ;;;; Boston, MA 02110-1301 USA
20 (define-module (oop goops accessors)
21 :use-module (oop goops)
22 :re-export (standard-define-class)
23 :export (define-class-with-accessors
24 define-class-with-accessors-keywords))
26 (define define-class-with-accessors
27 (procedure->memoizing-macro
29 (let ((name (cadr exp))
33 `(standard-define-class ,name ,supers
43 (if (get-keyword #:accessor (cdr slot) #f)
45 (let ((name (car slot)))
46 `(,name #:accessor ,name ,@(cdr slot)))))
48 `(,slot #:accessor ,slot))))
51 (define define-class-with-accessors-keywords
52 (procedure->memoizing-macro
54 (let ((name (cadr exp))
58 `(standard-define-class ,name ,supers
69 (if (get-keyword #:accessor (cdr slot) #f)
71 (let ((name (car slot)))
72 `(,name #:accessor ,name ,@(cdr slot))))))
73 (if (get-keyword #:init-keyword (cdr slot) #f)
75 (let* ((name (car slot))
76 (keyword (symbol->keyword name)))
77 `(,name #:init-keyword ,keyword ,@(cdr slot))))))
79 `(,slot #:accessor ,slot
80 #:init-keyword ,(symbol->keyword slot)))))