srfi/srfi-9.scm

   1 ;;;; srfi-9.scm --- SRFI-9 procedures for Guile
   2 ;;;;
   3 ;;;;    Copyright (C) 2001 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This program is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU General Public License as
   7 ;;;; published by the Free Software Foundation; either version 2, or
   8 ;;;; (at your option) any later version.
   9 ;;;;
  10 ;;;; This program is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU General Public License
  16 ;;;; along with this software; see the file COPYING.  If not, write to
  17 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  18 ;;;; Boston, MA 02111-1307 USA
  19
  20 ;;; Commentary:
  21
  22 ;;; This module exports the syntactic form `define-record-type', which
  23 ;;; is the means for creating record types defined in SRFI-9.
  24 ;;;
  25 ;;; The syntax of a record type definition is:
  26 ;;;
  27 ;;;  <record type definition>
  28 ;;;    -> (define-record-type <type name>
  29 ;;;         (<constructor name> <field tag> ...)
  30 ;;;         <predicate name>
  31 ;;;         <field spec> ...)
  32 ;;;
  33 ;;;  <field spec> -> (<field tag> <accessor name>)
  34 ;;;               -> (<field tag> <accessor name> <modifier name>)
  35 ;;;
  36 ;;;  <field tag> -> <identifier>
  37 ;;;  <... name>  -> <identifier>
  38 ;;;
  39 ;;; Usage example:
  40 ;;;
  41 ;;; guile> (use-modules (srfi srfi-9))
  42 ;;; guile> (define-record-type :foo (make-foo x) foo?
  43 ;;;                            (x get-x) (y get-y set-y!))
  44 ;;; guile> (define f (make-foo 1))
  45 ;;; guile> f
  46 ;;; #<:foo x: 1 y: #f>
  47 ;;; guile> (get-x f)
  48 ;;; 1
  49 ;;; guile> (set-y! f 2)
  50 ;;; 2
  51 ;;; guile> (get-y f)
  52 ;;; 2
  53 ;;; guile> f
  54 ;;; #<:foo x: 1 y: 2>
  55 ;;; guile> (foo? f)
  56 ;;; #t
  57 ;;; guile> (foo? 1)
  58 ;;; #f
  59
  60 ;;; Code:
  61
  62 (define-module (srfi srfi-9))
  63
  64 (export-syntax define-record-type)
  65
  66 (cond-expand-provide (current-module) '(srfi-9))
  67
  68 (define-macro (define-record-type type-name constructor/field-tag
  69                 predicate-name . field-specs)
  70   `(begin
  71      (define ,type-name
  72        (make-record-type ',type-name ',(map car field-specs)))
  73      (define ,(car constructor/field-tag)
  74        (record-constructor ,type-name ',(cdr constructor/field-tag)))
  75      (define ,predicate-name
  76        (record-predicate ,type-name))
  77      ,@(map
  78         (lambda (spec)
  79           (cond
  80            ((= (length spec) 2)
  81             `(define ,(cadr spec)
  82                (record-accessor ,type-name ',(car spec))))
  83            ((= (length spec) 3)
  84             `(begin
  85                (define ,(cadr spec)
  86                  (record-accessor ,type-name ',(car spec)))
  87                (define ,(caddr spec)
  88                  (record-modifier ,type-name ',(car spec)))))
  89            (else
  90             (error "invalid field spec " spec))))
  91         field-specs)))