mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

* Makefile.am (srfi_DATA): Added srfi-9.scm.

Browse source 
* srfi-9.scm: New file.  Exports `define-record-type'.
This commit is contained in:
Martin Grabmüller 2001-04-27 05:47:58 +00:00
parent 7a6a68b105
commit a6fd89a497
3 changed files with 92 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

6
srfi/ChangeLog
View file

@ -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> 2001-04-26 Rob Browning <rlb@cs.utexas.edu>
* Makefile.am (srfi_DATA): added srfi-6.scm. * Makefile.am (srfi_DATA): added srfi-6.scm.

1
srfi/Makefile.am
View file

@ -42,6 +42,7 @@ srfidir = $(datadir)/guile/$(VERSION)/srfi
srfi_DATA = srfi-2.scm \ srfi_DATA = srfi-2.scm \
srfi-6.scm \ srfi-6.scm \
srfi-8.scm \ srfi-8.scm \
srfi-9.scm \
srfi-11.scm \ srfi-11.scm \
srfi-13.scm \ srfi-13.scm \
srfi-14.scm srfi-14.scm

85
srfi/srfi-9.scm Normal file
View file

@ -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)))