From 1bdacb30be136d4f97a398ad93090cd9ba7ace73 Mon Sep 17 00:00:00 2001 From: Chris Hanson 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 + (%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! (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 + (%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