Use DEFINE-RECORD-TYPE to make record descriptions more succinct.

diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index faabef5577ef806056dec94c680d036be6ee2ce5..4fe59be4d05dd67537f1d52f8e7ad89b65c9181e 100644 (file)
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.27 2003/03/07 05:47:41 cph Exp $
+$Id: port.scm,v 1.28 2003/03/07 20:36:53 cph Exp $
 
 Copyright 1991,1992,1993,1994,1997,1999 Massachusetts Institute of Technology
 Copyright 2001,2002,2003 Massachusetts Institute of Technology
@@ -168,21 +168,19 @@ USA.
          (and accessor
               (accessor type))))))
 \f
-(define port-rtd (make-record-type "port" '(TYPE STATE THREAD-MUTEX)))
-(define %make-port (record-constructor port-rtd '(TYPE STATE THREAD-MUTEX)))
-(define port? (record-predicate port-rtd))
-(define port/type (record-accessor port-rtd 'TYPE))
-(define %port/state (record-accessor port-rtd 'STATE))
-(define port/thread-mutex (record-accessor port-rtd 'THREAD-MUTEX))
-(define set-port/thread-mutex! (record-modifier port-rtd 'THREAD-MUTEX))
+(define-record-type <port>
+    (%make-port type state thread-mutex)
+    port?
+  (type port/type)
+  (state %port/state %set-port/state!)
+  (thread-mutex port/thread-mutex)
+  (thread-mutex set-port/thread-mutex!))
 
 (define (port/state port)
   (%port/state (base-port port)))
 
-(define set-port/state!
-  (let ((modifier (record-modifier port-rtd 'STATE)))
-    (lambda (port state)
-      (modifier (base-port port) state))))
+(define (set-port/state! port state)
+  (%set-port/state! (base-port port) state))
 
 (define (base-port port)
   (let ((state (%port/state port)))
@@ -217,7 +215,7 @@ USA.
 (define (output-port/operation/discretionary-flush port)
   (port-type/discretionary-flush-output (port/type port)))
 
-(set-record-type-unparser-method! port-rtd
+(set-record-type-unparser-method! <port>
   (lambda (state port)
     ((let ((name
            (cond ((i/o-port? port) 'I/O-PORT)

diff --git a/v7/src/runtime/rep.scm b/v7/src/runtime/rep.scm
index 965dc96ed65ab295371e323daeebed99fc582017..3204c3276ed329645b4431ebc1f47d57cd9fbd08 100644 (file)
--- a/v7/src/runtime/rep.scm
+++ b/v7/src/runtime/rep.scm
@@ -1,8 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: rep.scm,v 14.59 2003/02/14 18:28:33 cph Exp $
+$Id: rep.scm,v 14.60 2003/03/07 20:41:23 cph Exp $
 
-Copyright (c) 1988-2001 Massachusetts Institute of Technology
+Copyright 1986,1987,1988,1989,1990,1991 Massachusetts Institute of Technology
+Copyright 1992,1993,1994,1998,1999,2001 Massachusetts Institute of Technology
+Copyright 2003 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -62,43 +64,34 @@ USA.
 \f
 ;;;; Command Loops
 
-(define cmdl-rtd
-  (make-record-type "cmdl"
-                   '(LEVEL PARENT PORT DRIVER STATE OPERATIONS PROPERTIES)))
-
-(define cmdl? (record-predicate cmdl-rtd))
-(define cmdl/level (record-accessor cmdl-rtd 'LEVEL))
-(define cmdl/parent (record-accessor cmdl-rtd 'PARENT))
-(define cmdl/port (record-accessor cmdl-rtd 'PORT))
-(define set-cmdl/port! (record-updater cmdl-rtd 'PORT))
-(define cmdl/driver (record-accessor cmdl-rtd 'DRIVER))
-(define cmdl/state (record-accessor cmdl-rtd 'STATE))
-(define set-cmdl/state! (record-updater cmdl-rtd 'STATE))
-(define cmdl/operations (record-accessor cmdl-rtd 'OPERATIONS))
-(define cmdl/properties (record-accessor cmdl-rtd 'PROPERTIES))
-
-(define make-cmdl
-  (let ((constructor
-        (record-constructor
-         cmdl-rtd
-         '(LEVEL PARENT PORT DRIVER STATE OPERATIONS PROPERTIES))))
-    (lambda (parent port driver state operations)
-      (if (not (or (not parent) (cmdl? parent)))
-         (error:wrong-type-argument parent "cmdl" 'MAKE-CMDL))
-      (if (not (or parent port))
-         (error:bad-range-argument port 'MAKE-CMDL))
-      (constructor (if parent (+ (cmdl/level parent) 1) 1)
-                  parent
-                  (let ((port* (and parent (cmdl/child-port parent))))
-                    (if port
-                        (if (eq? port port*)
-                            port
-                            (make-transcriptable-port port))
-                        port*))
-                  driver
-                  state
-                  (parse-operations-list operations 'MAKE-CMDL)
-                  (make-1d-table)))))
+(define-record-type <cmdl>
+    (%make-cmdl level parent port driver state operations properties)
+    cmdl?
+  (level cmdl/level)
+  (parent cmdl/parent)
+  (port cmdl/port set-cmdl/port!)
+  (driver cmdl/driver)
+  (state cmdl/state set-cmdl/state!)
+  (operations cmdl/operations)
+  (properties cmdl/properties))
+
+(define (make-cmdl parent port driver state operations)
+  (if (not (or (not parent) (cmdl? parent)))
+      (error:wrong-type-argument parent "cmdl" 'MAKE-CMDL))
+  (if (not (or parent port))
+      (error:bad-range-argument port 'MAKE-CMDL))
+  (%make-cmdl (if parent (+ (cmdl/level parent) 1) 1)
+             parent
+             (let ((port* (and parent (cmdl/child-port parent))))
+               (if port
+                   (if (eq? port port*)
+                       port
+                       (make-transcriptable-port port))
+                   port*))
+             driver
+             state
+             (parse-operations-list operations 'MAKE-CMDL)
+             (make-1d-table)))
 
 (define (cmdl/child-port cmdl)
   (or (let ((operation (cmdl/local-operation cmdl 'CHILD-PORT)))