summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMartin Grabmüller <mgrabmue@cs.tu-berlin.de>2001-04-27 05:47:58 +0000
committerMartin Grabmüller <mgrabmue@cs.tu-berlin.de>2001-04-27 05:47:58 +0000
commita6fd89a4975cde56bf42c452257dc0070b4525d5 (patch)
treef15c0de16179ea7a39ccf60e432096480133ebc6
parent7a6a68b1053e47d81b0ff7f5752c7f058598b665 (diff)
downloadguile-a6fd89a4975cde56bf42c452257dc0070b4525d5.tar.gz
* Makefile.am (srfi_DATA): Added srfi-9.scm.
* srfi-9.scm: New file. Exports `define-record-type'.
-rw-r--r--srfi/ChangeLog6
-rw-r--r--srfi/Makefile.am1
-rw-r--r--srfi/srfi-9.scm85
3 files changed, 92 insertions, 0 deletions
diff --git a/srfi/ChangeLog b/srfi/ChangeLog
index 04dcf8567..8e2c0b759 100644
--- a/srfi/ChangeLog
+++ b/srfi/ChangeLog
@@ -1,3 +1,9 @@
+2001-04-27 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
+
+ * Makefile.am (srfi_DATA): Added srfi-9.scm.
+
+ * srfi-9.scm: New file. Exports `define-record-type'.
+
2001-04-26 Rob Browning <rlb@cs.utexas.edu>
* Makefile.am (srfi_DATA): added srfi-6.scm.
diff --git a/srfi/Makefile.am b/srfi/Makefile.am
index 804c2f882..5eb8eb9cc 100644
--- a/srfi/Makefile.am
+++ b/srfi/Makefile.am
@@ -42,6 +42,7 @@ srfidir = $(datadir)/guile/$(VERSION)/srfi
srfi_DATA = srfi-2.scm \
srfi-6.scm \
srfi-8.scm \
+ srfi-9.scm \
srfi-11.scm \
srfi-13.scm \
srfi-14.scm
diff --git a/srfi/srfi-9.scm b/srfi/srfi-9.scm
new file mode 100644
index 000000000..fb61dfec0
--- /dev/null
+++ b/srfi/srfi-9.scm
@@ -0,0 +1,85 @@
+;;;; 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
+
+;;; This module exports the syntactic form `define-record-type', which
+;;; is the means for creating record types defined in SRFI-9.
+;;;
+;;; The syntax of a record type definition is:
+;;;
+;;; <record type definition>
+;;; -> (define-record-type <type name>
+;;; (<constructor name> <field tag> ...)
+;;; <predicate name>
+;;; <field spec> ...)
+;;;
+;;; <field spec> -> (<field tag> <accessor name>)
+;;; -> (<field tag> <accessor name> <modifier name>)
+;;;
+;;; <field tag> -> <identifier>
+;;; <... name> -> <identifier>
+;;;
+;;; Usage example:
+;;;
+;;; guile> (use-modules (srfi srfi-9))
+;;; guile> (define-record-type :foo (make-foo x) foo?
+;;; (x get-x) (y get-y set-y!))
+;;; guile> (define f (make-foo 1))
+;;; guile> f
+;;; #<:foo x: 1 y: #f>
+;;; guile> (get-x f)
+;;; 1
+;;; guile> (set-y! f 2)
+;;; 2
+;;; guile> (get-y f)
+;;; 2
+;;; guile> f
+;;; #<:foo x: 1 y: 2>
+;;; guile> (foo? f)
+;;; #t
+;;; guile> (foo? 1)
+;;; #f
+
+(define-module (srfi srfi-9))
+
+(export-syntax 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)))