From 1bdacb30be136d4f97a398ad93090cd9ba7ace73 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 7 Mar 2003 20:41:23 +0000
Subject: [PATCH] Use DEFINE-RECORD-TYPE to make record descriptions more
succinct.
---
v7/src/runtime/port.scm | 24 +++++++-------
v7/src/runtime/rep.scm | 71 +++++++++++++++++++----------------------
2 files changed, 43 insertions(+), 52 deletions(-)
diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index faabef557..4fe59be4d 100644
--- 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))))))
-(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 965dc96ed..3204c3276 100644
--- 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.
;;;; 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)))
--
2.25.1