guile18/srfi/srfi-9.scm

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