module/srfi/srfi-9.mes

   1 ;;; -*-scheme-*-
   2
   3 ;;; Mes --- Maxwell Equations of Software
   4 ;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
   5 ;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
   6 ;;;
   7 ;;; base-0.mes: This file is part of Mes.
   8 ;;;
   9 ;;; Mes is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; Mes is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;;; srfi-9.mes - records.  Assumes record-0.mes and record.mes are
  25 ;;; available.  Modified from
  26 ;;; scheme48-1.1/scheme/alt/jar-defrecord.scm to implement SRFI-9.
  27
  28 ;;; Code:
  29
  30 ;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
  31
  32 ;;; scheme48-1.1/COPYING
  33
  34 ;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
  35 ;; All rights reserved.
  36
  37 ;; Redistribution and use in source and binary forms, with or without
  38 ;; modification, are permitted provided that the following conditions
  39 ;; are met:
  40 ;; 1. Redistributions of source code must retain the above copyright
  41 ;;    notice, this list of conditions and the following disclaimer.
  42 ;; 2. Redistributions in binary form must reproduce the above copyright
  43 ;;    notice, this list of conditions and the following disclaimer in the
  44 ;;    documentation and/or other materials provided with the distribution.
  45 ;; 3. The name of the authors may not be used to endorse or promote products
  46 ;;    derived from this software without specific prior written permission.
  47
  48 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
  49 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
  50 ;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
  51 ;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
  52 ;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
  53 ;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  54 ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  55 ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  56 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
  57 ;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  58
  59 ; This is JAR's define-record-type, which doesn't resemble Richard's.
  60
  61 ; There's no implicit name concatenation, so it can be defined
  62 ; entirely using syntax-rules.  Example:
  63 ;  (define-record-type foo :foo
  64 ;    (make-foo x y)
  65 ;    foo?              - predicate name is optional
  66 ;    (x foo-x)
  67 ;    (y foo-y)
  68 ;    (z foo-z set-foo-z!))
  69
  70 (define-syntax define-record-type
  71   (syntax-rules ()
  72     ((define-record-type type
  73        (constructor arg ...)
  74        (field . field-stuff)
  75        ...)
  76      (begin (define type (make-record-type 'type '(field ...)))
  77             (define constructor (record-constructor type '(arg ...)))
  78             (define-accessors type (field . field-stuff) ...)))
  79     ((define-record-type type
  80        (constructor arg ...)
  81        pred
  82        more ...)
  83      (begin (define-record-type type
  84               (constructor arg ...)
  85               more ...)
  86             (define pred (record-predicate type))))))
  87
  88 ;; Straightforward version
  89 (define-syntax define-accessors
  90   (syntax-rules ()
  91     ((define-accessors type field-spec ...)
  92      (begin (define-accessor type . field-spec) ...))))
  93
  94 (define-syntax define-accessor
  95   (syntax-rules ()
  96     ((define-accessor type field accessor)
  97      (define accessor (record-accessor type 'field)))
  98     ((define-accessor type field accessor modifier)
  99      (begin (define accessor (record-accessor type 'field))
 100             (define modifier (record-modifier type 'field))))))