More SRFI stuff

[Martin Grabmueller]

Hello list,

as we are currently going through all the SRFIs, another question.

Does anybody out there have a better (faster/smaller/more elegant)
implementation of SRFI-9 (Defining Record Types) than my version
attached below?

If not, I'll go ahead and add it to the `srfi' directory.  Otherwise
we could see which version to include.

Regards,
  'martin


===File ~/cvs/guile/guile-core/srfi/srfi-9.scm==============
;;;; srfi-9.scm --- SRFI-9 procedures for Guile
;;;;
;;;;    Copyright (C) 2001 Free Software Foundation, Inc.
;;;; 
;;;; This program is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU General Public License as
;;;; published by the Free Software Foundation; either version 2, or
;;;; (at your option) any later version.
;;;; 
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU General Public License
;;;; along with this software; see the file COPYING.  If not, write to
;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;; Boston, MA 02111-1307 USA

(define-module (srfi srfi-9))

(export define-record-type)

(define-macro (define-record-type type-name constructor/field-tag
                predicate-name . field-specs)
  `(begin
     (define ,type-name
       (make-record-type ',type-name ',(map car field-specs)))
     (define ,(car constructor/field-tag)
       (record-constructor ,type-name ',(cdr constructor/field-tag)))
     (define ,predicate-name
       (record-predicate ,type-name))
     ,@(map
        (lambda (spec)
          (cond
           ((= (length spec) 2)
            `(define ,(cadr spec)
               (record-accessor ,type-name ',(car spec))))
           ((= (length spec) 3)
            `(begin
               (define ,(cadr spec)
                 (record-accessor ,type-name ',(car spec)))
               (define ,(caddr spec)
                 (record-modifier ,type-name ',(car spec)))))
           (else
            (error "invalid field spec " spec))))
        field-specs)))
============================================================