mes: Reimplement records.
authorJan Nieuwenhuizen <janneke@gnu.org>
Mon, 11 Dec 2017 23:12:42 +0000 (00:12 +0100)
committerJan Nieuwenhuizen <janneke@gnu.org>
Mon, 11 Dec 2017 23:12:42 +0000 (00:12 +0100)
* module/srfi/srfi-9.mes (define-record-type): New macro.
* AUTHORS: Update.
* module/mes/record-0.mes: Remove.
* module/mes/record.mes: Remove.
* module/srfi/srfi-9-psyntax.mes: Remove.
* module/srfi/srfi-9.scm: Remove.
* make.scm: Remove them.

AUTHORS
make.scm
module/mes/record-0.mes [deleted file]
module/mes/record.mes [deleted file]
module/srfi/srfi-9-psyntax.mes [deleted file]
module/srfi/srfi-9.mes
module/srfi/srfi-9.scm [deleted file]

diff --git a/AUTHORS b/AUTHORS
index 7a6288462798d3621aaa84514d8c61c5b0033703..ec2043d6ef2e463b348805544021f5f752b2852e 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -2,11 +2,6 @@ Jan Nieuwenhuizen <janneke@gnu.org>
 Main author
 All files except the files listed below
 
-Based on Scheme48's scheme/alt
-module/mes/record.mes
-module/mes/syntax.scm
-module/srfi/srfi-9.scm
-
 Based on Guile ECMAScript
 module/language/c/lexer.mes
 
index b39cb12d1fc6edfb7a72fb6660221b614a245f2e..af2b0843266e3c029d471ee1c829daef7524d7f6 100755 (executable)
--- a/make.scm
+++ b/make.scm
@@ -565,8 +565,6 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
    "module/mes/quasisyntax.mes"
    "module/mes/quasisyntax.scm"
    "module/mes/read-0.mes"
-   "module/mes/record-0.mes"
-   "module/mes/record.mes"
    "module/mes/repl.mes"
    "module/mes/scm.mes"
    "module/mes/syntax.mes"
@@ -594,9 +592,7 @@ exec ${GUILE-guile} --no-auto-compile -L . -L guile -C . -C guile -s "$0" ${1+"$
    "module/srfi/srfi-26.mes"
    "module/srfi/srfi-26.scm"
    "module/srfi/srfi-43.mes"
-   "module/srfi/srfi-9-psyntax.mes"
    "module/srfi/srfi-9.mes"
-   "module/srfi/srfi-9.scm"
    "module/sxml/xpath.mes"
    "module/sxml/xpath.scm"))
 
diff --git a/module/mes/record-0.mes b/module/mes/record-0.mes
deleted file mode 100644 (file)
index 23a9d77..0000000
+++ /dev/null
@@ -1,38 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes 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 Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; record-0.mes mes-specific definitions needed for record.mes
-
-;;; Code:
-
-(define (unspecific) (if #f #f))
-(define make-record make-vector)
-(define record-set! vector-set!)
-(define record? vector?)
-(define (record-type x) (vector-ref x 0))
-(define record-ref vector-ref)
-(define (call-error message . rest)
-  (display "call-error:" (current-error-port))
-  (display message (current-error-port))
-  (display ":" (current-error-port))
-  (display rest (current-error-port))
-  (newline (current-error-port)))
diff --git a/module/mes/record.mes b/module/mes/record.mes
deleted file mode 100644 (file)
index ddc0249..0000000
+++ /dev/null
@@ -1,258 +0,0 @@
-;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes 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 Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; record.mes is loaded after record-0.mes.  It provides a
-;;; nonstandard record type that SRFI-9 can be trivially implemented
-;;; on.  Adapted from scheme48-1.1/scheme/rts/record.scm
-
-;;; Code:
-
-;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
-
-;;; scheme48-1.1/COPYING
-
-;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
-;; All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;; 1. Redistributions of source code must retain the above copyright
-;;    notice, this list of conditions and the following disclaimer.
-;; 2. Redistributions in binary form must reproduce the above copyright
-;;    notice, this list of conditions and the following disclaimer in the
-;;    documentation and/or other materials provided with the distribution.
-;; 3. The name of the authors may not be used to endorse or promote products
-;;    derived from this software without specific prior written permission.
-
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
-;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
-;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
-;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;;;; Records
-
-; Every record in the image is assumed to be made either by MAKE-RECORD-TYPE
-; or by a procedure returned by record-constructor.  A record-type is a
-; record that describes a type of record.  At the end of the file we create
-; a record type that describes record types.
-
-; We number the record types for debugging purposes.
-
-(define *record-type-uid* -1)
-
-; This is the record type that describes record types.  It is set a the end
-; of the file.  Its first slot points to itself.
-
-(define *record-type* #f)
-
-; Make a record type from a name, used for printing and debugging, and
-; a list of field names.
-;
-; The VM references both the record type and the resumer, so their offsets
-; should not be changed.
-
-(define (make-record-type name field-names)
-  (set! *record-type-uid* (+ *record-type-uid* 1))
-  (let ((r (make-record 7 (unspecific))))
-    (record-set! r 0 *record-type*)
-    (record-set! r 1 default-record-resumer)
-    (record-set! r 2 *record-type-uid*)
-    (record-set! r 3 name)
-    (record-set! r 4 field-names)
-    (record-set! r 5 (length field-names))
-    (record-set! r 6 (make-default-record-discloser name))
-    r))
-
-(define (record-type? obj)
-  (and (record? obj)
-       (eq? (record-type obj) *record-type*)))
-
-; The various fields in a record type.
-
-(define (record-type-resumer rt)          (record-ref rt 1))
-(define (set-record-type-resumer! rt r)   (record-set! rt 1 r))
-(define (record-type-uid rt)              (record-ref rt 2))
-(define (record-type-name rt)             (record-ref rt 3))
-(define (record-type-field-names rt)      (record-ref rt 4))
-(define (record-type-number-of-fields rt) (record-ref rt 5))
-(define (record-type-discloser rt)        (record-ref rt 6))
-(define (set-record-type-discloser! rt d) (record-set! rt 6 d))
-
-; This is a hack; it is read by the script that makes c/scheme48.h.
-
-(define record-type-fields
-  '(resumer uid name field-names number-of-fields discloser))
-
-;----------------
-; Given a record type and the name of a field, return the field's index.
-
-(define (record-field-index rt name)
-  (let loop ((names (record-type-field-names rt))
-             (i 1))
-    (cond ((null? names)
-           (error "unknown field"
-                  (record-type-name rt)
-                  name))
-          ((eq? name (car names))
-           i)
-          (else
-           (loop (cdr names) (+ i 1))))))
-
-; Return procedure for contstruction records of type RT.  NAMES is a list of
-; field names which the constructor will take as arguments.  Other fields are
-; uninitialized.
-
-(define (record-constructor rt names)
-  (let ((indexes (map (lambda (name)
-                        (record-field-index rt name))
-                      names))
-        (size (+ 1 (record-type-number-of-fields rt))))
-    (lambda args
-      (let ((r (make-record size (unspecific))))
-        (record-set! r 0 rt)
-        (let loop ((is indexes) (as args))
-          (if (null? as)
-              (if (null? is)
-                  r
-                  (error "too few arguments to record constructor"
-                         rt names args))
-              (if (null? is)
-                  (error "too many arguments to record constructor"
-                         rt names args)
-                  (begin (record-set! r (car is) (car as))
-                         (loop (cdr is) (cdr as))))))))))
-
-; Making accessors, modifiers, and predicates for record types.
-
-(define (record-accessor rt name)
-  (let ((index (record-field-index rt name))
-        (error-cruft `(record-accessor ,rt ',name)))
-    (lambda (r)
-      (if (eq? (record-type r) rt)
-          (record-ref r index)
-          (call-error "invalid record access" error-cruft r)))))
-
-(define (record-modifier rt name)
-  (let ((index (record-field-index rt name))
-        (error-cruft `(record-modifier ,rt ',name)))
-    (lambda (r x)
-      (if (eq? (record-type r) rt)
-          (record-set! r index x)
-          (call-error "invalid record modification" error-cruft r x)))))
-
-(define (record-predicate rt)
-  (lambda (x)
-    (and (record? x)
-         (eq? (record-type x) rt))))
-
-;----------------
-; A discloser is a procedure that takes a record of a particular type and
-; returns a list whose head is a string or symbol and whose tail is other
-; stuff.
-;
-; Set the discloser for record type RT.
-
-(define (define-record-discloser rt proc)
-  (if (and (record-type? rt)
-           (procedure? proc))
-      (set-record-type-discloser! rt proc)
-      (call-error "invalid argument" define-record-discloser rt proc)))
-
-; By default we just return the name of the record type.
-
-(define (make-default-record-discloser record-type-name)
-  (lambda (r)
-    (list record-type-name)))
-
-; DISCLOSE-RECORD calls the record's discloser procedure to obtain a list.
-
-(define (disclose-record r)
-  (if (record? r)
-      (let ((rt (record-type r)))
-        (if (record-type? rt)
-            ((record-type-discloser rt) r)
-            #f))
-      #f))
-
-;----------------
-; A resumer is a procedure that the VM calls on all records of a given
-; type on startup.
-;
-; A resumer may be:
-;  #t -> do nothing on startup.
-;  #f -> records of this type do not survive a dump/resume; in images they
-;        are replaced by their first slot (so we make sure they have one)
-;  a one-argument procedure -> pass the record to this procedure
-;
-; Resumers are primarily intended for use by external code which keeps
-; fields in records which do not survive a dump under their own power.
-; For example, a record may contain a reference to a OS-dependent value.
-;
-; Resumers are called by the VM on startup.
-
-(define (define-record-resumer rt resumer)
-  (if (and (record-type? rt)
-           (or (eq? #t resumer)
-               (and (eq? #f resumer)
-                    (< 0 (record-type-number-of-fields rt)))
-               (procedure? resumer)))
-      (set-record-type-resumer! rt resumer)
-      (call-error "invalid argument" define-record-resumer rt resumer)))
-
-; By default we leave records alone.
-
-(define default-record-resumer
-  #t)
-
-(define (initialize-records! resumer-records)
-  (if (vector? resumer-records)
-      (do ((i 0 (+ i 1)))
-          ((= i (vector-length resumer-records)))
-        (resume-record (vector-ref resumer-records i)))))
-
-(define (resume-record record)
-  ((record-type-resumer (record-type record))
-     record))
-
-;----------------
-; Initializing *RECORD-TYPE* and making a type.
-
-(set! *record-type*
-      (make-record-type 'record-type record-type-fields))
-
-(record-set! *record-type* 0 *record-type*)
-
-(define :record-type *record-type*)
-
-(define-record-discloser :record-type
-  (lambda (rt)
-    (list 'record-type
-          (record-type-uid rt)
-          (record-type-name rt))))
diff --git a/module/srfi/srfi-9-psyntax.mes b/module/srfi/srfi-9-psyntax.mes
deleted file mode 100644 (file)
index 78ab8b9..0000000
+++ /dev/null
@@ -1,29 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes 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 Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; srfi-9.mes - records.
-
-(mes-use-module (mes scm))
-(mes-use-module (mes psyntax))
-(mes-use-module (mes record-0))
-(mes-use-module (mes record))
-(include-from-path "srfi/srfi-9.scm")
index 104c188ede44a05ecc073373e7447cab774ebd63..04d2f9c028b8ce3625b9dea71b63e87232eb0b7f 100644 (file)
@@ -1,7 +1,7 @@
 ;;; -*-scheme-*-
 
 ;;; Mes --- Maxwell Equations of Software
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2017 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 ;;; This file is part of Mes.
 ;;;
 
 ;;; srfi-9.mes - records.
 
-(mes-use-module (mes scm))
-(mes-use-module (mes syntax))
-(mes-use-module (mes record-0))
-(mes-use-module (mes record))
-(include-from-path "srfi/srfi-9.scm")
+(define (lst-index lst o)
+  (let loop ((lst lst) (i 0))
+    (and (pair? lst)
+         (if (equal? o (car lst)) i
+             (loop (cdr lst) (1+ i))))))
+
+(define (make-record-type type fields)
+  (list->vector (list '*record-type* type fields (length fields))))
+
+(define (record-type o)
+  (vector-ref o 0))
+
+(define (record-type? o)
+  (eq? (record-type o) '*record-type*))
+
+(define (record-constructor type params)
+  (let ((fields (record-fields type)))
+    (lambda (. o)
+      (if (not (= (length o) (length params))) (error "wrong number of arguments for record-constructor")
+          (let ((rest (make-list (- (length fields) (length params)))))
+            (list->vector (cons type (append o rest))))))))
+
+(define (record-fields o)
+  (vector-ref o 2))
+
+(define (record-field-index type field)
+  (1+ (or (lst-index (record-fields type) field)
+          (error "no such field" type field))))
+
+(define (record-getter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o)
+      (if (not (eq? (record-type o) type)) (error "record getter: record expected" type o)
+          (vector-ref o i)))))
+
+(define (record-setter type field)
+  (let ((i (record-field-index type field)))
+    (lambda (o v)
+      (if (not (eq? (record-type o) type)) (error "record setter: record expected" type o)
+          (vector-set! o i v)))))
+
+(define (record-predicate type)
+  (lambda (o)
+    (and (vector? o)
+         (eq? (record-type o) type))))
+
+(define-macro (define-record-accessors type . fields)
+  `(begin
+     ,@(map (lambda (field)
+              `(define-record-accessor ,type ,field))
+            fields)))
+
+(define-macro (define-record-accessor type field)
+  `(begin
+     (define ,(cadr field) ,(record-getter type (car field)))
+     (if ,(pair? (cddr field))
+         (define ,(if (pair? (cddr field)) (caddr field)) ,(record-setter type (car field))))))
+
+(define-macro (define-record-type type constructor+params predicate . fields)
+  (let ((record (make-record-type type (map car fields))))
+   `(begin
+      (define ,type ,record)
+      (define ,(car constructor+params) ,(record-constructor record (cdr constructor+params)))
+      (define ,predicate ,(record-predicate record))
+      (define-record-accessors ,record ,@fields))))
+
+;; (define-record-type cpi
+;;   (make-cpi-1)
+;;   cpi?
+;;   (debug cpi-debug set-cpi-debug!)  ; debug #t #f
+;;   (defines cpi-defs set-cpi-defs!)  ; #defines
+;;   (incdirs cpi-incs set-cpi-incs!)  ; #includes
+;;   (inc-tynd cpi-itynd set-cpi-itynd!)       ; a-l of incfile => typenames
+;;   (inc-defd cpi-idefd set-cpi-idefd!)       ; a-l of incfile => defines
+;;   (ptl cpi-ptl set-cpi-ptl!)                ; parent typename list
+;;   (ctl cpi-ctl set-cpi-ctl!)                ; current typename list
+;;   (blev cpi-blev set-cpi-blev!)             ; curr brace/block level
+;;   )
+
+;; (display cpi)
+;; (newline)
+;; (display make-cpi-1)
+;; (newline)
+;; (define cpi (make-cpi-1))
+;; (set-cpi-debug! cpi #t)
+;; (set-cpi-blev! cpi #t)
+
+
+;; (define-record-type <employee> (make-employee name age salary) employee? (name employe-name) (age  employee-age set-employee-age!) (salary employee-salary))
+
+;; (display <employee>)
+;; (newline)
+;; (display make-employee)
+;; (newline)
+;; (display "employee-age ")
+;; (display employee-age)
+;; (newline)
+
+;; (display "set-employee-age! ")
+;; (display set-employee-age!)
+;; (newline)
+
+;; (define janneke (make-employee "janneke" 49 42))
+;; (display janneke)
+;; (newline)
+
+;; (display (employee-age janneke))
+;; (newline)
+
+;; (display (set-employee-age! janneke 33))
+;; (newline)
+;; (display (employee-age janneke))
+;; (newline)
diff --git a/module/srfi/srfi-9.scm b/module/srfi/srfi-9.scm
deleted file mode 100644 (file)
index 47b5161..0000000
+++ /dev/null
@@ -1,100 +0,0 @@
-;;; -*-scheme-*-
-
-;;; Mes --- Maxwell Equations of Software
-;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees.
-;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-;;; This file is part of Mes.
-;;;
-;;; Mes 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 3 of the License, or (at
-;;; your option) any later version.
-;;;
-;;; Mes 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 Mes.  If not, see <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-
-;;; srfi-9.mes - records.  Assumes record-0.mes and record.mes are
-;;; available.  Modified from
-;;; scheme48-1.1/scheme/alt/jar-defrecord.scm to implement SRFI-9.
-
-;;; Code:
-
-;;; Copyright (c) 1993-2004 by Richard Kelsey and Jonathan Rees. See file COPYING.
-
-;;; scheme48-1.1/COPYING
-
-;; Copyright (c) 1993-2004 Richard Kelsey and Jonathan Rees
-;; All rights reserved.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;; 1. Redistributions of source code must retain the above copyright
-;;    notice, this list of conditions and the following disclaimer.
-;; 2. Redistributions in binary form must reproduce the above copyright
-;;    notice, this list of conditions and the following disclaimer in the
-;;    documentation and/or other materials provided with the distribution.
-;; 3. The name of the authors may not be used to endorse or promote products
-;;    derived from this software without specific prior written permission.
-
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
-;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
-;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT,
-;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
-;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
-;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-; This is JAR's define-record-type, which doesn't resemble Richard's.
-
-; There's no implicit name concatenation, so it can be defined
-; entirely using syntax-rules.  Example:
-;  (define-record-type foo :foo
-;    (make-foo x y)
-;    foo?              - predicate name is optional
-;    (x foo-x)
-;    (y foo-y)
-;    (z foo-z set-foo-z!))
-
-(define-syntax define-record-type
-  (syntax-rules ()
-    ((define-record-type type
-       (constructor arg ...)
-       (field . field-stuff)
-       ...)
-     (begin (define type (make-record-type 'type '(field ...)))
-            (define constructor (record-constructor type '(arg ...)))
-            (define-accessors type (field . field-stuff) ...)))
-    ((define-record-type type
-       (constructor arg ...)
-       pred
-       more ...)
-     (begin (define-record-type type
-              (constructor arg ...)
-              more ...)
-            (define pred (record-predicate type))))))
-
-;; Straightforward version
-(define-syntax define-accessors
-  (syntax-rules ()
-    ((define-accessors type field-spec ...)
-     (begin (define-accessor type . field-spec) ...))))
-
-(define-syntax define-accessor
-  (syntax-rules ()
-    ((define-accessor type field accessor)
-     (define accessor (record-accessor type 'field)))
-    ((define-accessor type field accessor modifier)
-     (begin (define accessor (record-accessor type 'field))
-            (define modifier (record-modifier type 'field))))))