#| -*-Scheme-*-
-$Id: port.scm,v 1.13 1999/02/16 05:17:42 cph Exp $
+$Id: port.scm,v 1.14 1999/02/16 19:43:17 cph Exp $
Copyright (c) 1991-1999 Massachusetts Institute of Technology
(declare (usual-integrations))
\f
-(define port-rtd
- (make-record-type "port"
- '(STATE
- THREAD-MUTEX
- OPERATION-NAMES
- CUSTOM-OPERATIONS
- ;; input operations:
- CHAR-READY?
- PEEK-CHAR
- READ-CHAR
- DISCARD-CHAR
- READ-STRING
- DISCARD-CHARS
- READ-SUBSTRING
- ;; output operations:
- WRITE-CHAR
- WRITE-SUBSTRING
- FLUSH-OUTPUT
- DISCRETIONARY-FLUSH-OUTPUT)))
-
-(define port? (record-predicate port-rtd))
-(define port/state (record-accessor port-rtd 'STATE))
-(define set-port/state! (record-updater port-rtd 'STATE))
-(define port/thread-mutex (record-accessor port-rtd 'THREAD-MUTEX))
-(define set-port/thread-mutex! (record-updater port-rtd 'THREAD-MUTEX))
-(define port/operation-names (record-accessor port-rtd 'OPERATION-NAMES))
-(define set-port/operation-names! (record-updater port-rtd 'OPERATION-NAMES))
-(define port/custom-operations (record-accessor port-rtd 'CUSTOM-OPERATIONS))
-
-(define input-port/operation/char-ready?
- (record-accessor port-rtd 'CHAR-READY?))
-
-(define input-port/operation/peek-char
- (record-accessor port-rtd 'PEEK-CHAR))
-
-(define input-port/operation/read-char
- (record-accessor port-rtd 'READ-CHAR))
-
-(define input-port/operation/discard-char
- (record-accessor port-rtd 'DISCARD-CHAR))
-
-(define input-port/operation/read-string
- (record-accessor port-rtd 'READ-STRING))
+(define-structure (port-type (type-descriptor port-type-rtd)
+ (conc-name port-type/)
+ (constructor %make-port-type (custom-operations)))
+ custom-operations
+ ;; input operations:
+ (char-ready? #f read-only #t)
+ (peek-char #f read-only #t)
+ (read-char #f read-only #t)
+ (discard-char #f read-only #t)
+ (read-string #f read-only #t)
+ (discard-chars #f read-only #t)
+ (read-substring #f read-only #t)
+ ;; output operations:
+ (write-char #f read-only #t)
+ (write-substring #f read-only #t)
+ (fresh-line #f read-only #t)
+ (flush-output #f read-only #t)
+ (discretionary-flush-output #f read-only #t))
+
+(set-record-type-unparser-method! port-type-rtd
+ (lambda (state type)
+ ((standard-unparser-method
+ (if (port-type/supports-input? type)
+ (if (port-type/supports-output? type)
+ 'I/O-PORT-TYPE
+ 'INPUT-PORT-TYPE)
+ (if (port-type/supports-output? type)
+ 'OUTPUT-PORT-TYPE
+ 'PORT-TYPE))
+ #f)
+ state
+ type)))
-(define input-port/operation/discard-chars
- (record-accessor port-rtd 'DISCARD-CHARS))
+(define (guarantee-port-type object procedure)
+ (if (not (port-type? object))
+ (error:wrong-type-argument object "port type" procedure))
+ object)
-(define input-port/operation/read-substring
- (record-accessor port-rtd 'READ-SUBSTRING))
+(define-integrable (port-type/supports-input? type)
+ (port-type/read-char type))
-(define output-port/operation/write-char
- (record-accessor port-rtd 'WRITE-CHAR))
+(define-integrable (port-type/supports-output? type)
+ (port-type/write-char type))
-(define output-port/operation/write-substring
- (record-accessor port-rtd 'WRITE-SUBSTRING))
+(define (input-port-type? object)
+ (and (port-type? object)
+ (port-type/supports-input? object)
+ #t))
-(define output-port/operation/flush-output
- (record-accessor port-rtd 'FLUSH-OUTPUT))
+(define (output-port-type? object)
+ (and (port-type? object)
+ (port-type/supports-output? object)
+ #t))
-(define output-port/operation/discretionary-flush
- (record-accessor port-rtd 'DISCRETIONARY-FLUSH-OUTPUT))
+(define (i/o-port-type? object)
+ (and (port-type? object)
+ (port-type/supports-input? object)
+ (port-type/supports-output? object)
+ #t))
+\f
+(define input-operation-names
+ '(CHAR-READY?
+ DISCARD-CHAR
+ DISCARD-CHARS
+ PEEK-CHAR
+ READ-CHAR
+ READ-STRING
+ READ-SUBSTRING))
+
+(define input-operation-accessors
+ (map (lambda (name) (record-accessor port-type-rtd name))
+ input-operation-names))
+
+(define input-operation-modifiers
+ (map (lambda (name) (record-modifier port-type-rtd name))
+ input-operation-names))
+
+(define output-operation-names
+ '(DISCRETIONARY-FLUSH-OUTPUT
+ FLUSH-OUTPUT
+ FRESH-LINE
+ WRITE-CHAR
+ WRITE-SUBSTRING))
+
+(define output-operation-accessors
+ (map (lambda (name) (record-accessor port-type-rtd name))
+ output-operation-names))
+
+(define output-operation-modifiers
+ (map (lambda (name) (record-modifier port-type-rtd name))
+ output-operation-names))
+
+(define (port-type/operation-names type)
+ (guarantee-port-type type 'PORT-TYPE/OPERATION-NAMES)
+ (append (if (port-type/supports-input? type) input-operation-names '())
+ (if (port-type/supports-output? type) output-operation-names '())
+ (map car (port-type/custom-operations type))))
+
+(define (port-type/operations type)
+ (guarantee-port-type type 'PORT-TYPE/OPERATIONS)
+ (append (if (port-type/supports-input? type)
+ (map (lambda (name accessor)
+ (list name (accessor type)))
+ input-operation-names
+ input-operation-accessors)
+ '())
+ (if (port-type/supports-output? type)
+ (map (lambda (name accessor)
+ (list name (accessor type)))
+ output-operation-names
+ output-operation-accessors)
+ '())
+ (map (lambda (entry)
+ (list (car entry) (cdr entry)))
+ (port-type/custom-operations type))))
+
+(define (port-type/operation type name)
+ (guarantee-port-type type 'PORT-TYPE/OPERATION)
+ ;; Optimized for custom operations, since standard operations will
+ ;; usually be accessed directly.
+ (let ((entry (assq name (port-type/custom-operations type))))
+ (if entry
+ (cdr entry)
+ (let ((accessor
+ (letrec ((loop
+ (lambda (names accessors)
+ (and (pair? names)
+ (if (eq? name (car names))
+ (car accessors)
+ (loop (cdr names) (cdr accessors)))))))
+ (or (and (port-type/supports-input? type)
+ (loop input-operation-names
+ input-operation-accessors))
+ (and (port-type/supports-output? type)
+ (loop output-operation-names
+ output-operation-accessors))))))
+ (and accessor
+ (accessor type))))))
\f
+(define port-rtd (make-record-type "port" '(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 set-port/state! (record-modifier 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 (port/operation-names port)
+ (port-type/operation-names (port/type port)))
+
+(let-syntax ((define-port-operation
+ (lambda (dir name)
+ `(DEFINE (,(symbol-append dir '-PORT/OPERATION/ name) PORT)
+ (,(symbol-append 'PORT-TYPE/ name) (PORT/TYPE PORT))))))
+ (define-port-operation input char-ready?)
+ (define-port-operation input peek-char)
+ (define-port-operation input read-char)
+ (define-port-operation input discard-char)
+ (define-port-operation input read-string)
+ (define-port-operation input discard-chars)
+ (define-port-operation input read-substring)
+ (define-port-operation output write-char)
+ (define-port-operation output write-substring)
+ (define-port-operation output fresh-line)
+ (define-port-operation output flush-output))
+
+(define (output-port/operation/discretionary-flush port)
+ (port-type/discretionary-flush-output (port/type port)))
+
(set-record-type-unparser-method! port-rtd
(lambda (state port)
((let ((name
(set-port/thread-mutex! port (make-thread-mutex))
port))
-(define (port/operation port name)
- ;; Optimized for custom operations, since standard operations will
- ;; usually be accessed directly.
- (let ((entry (assq name (port/custom-operations port))))
- (if entry
- (cdr entry)
- (case name
- ((CHAR-READY?) (input-port/operation/char-ready? port))
- ((PEEK-CHAR) (input-port/operation/peek-char port))
- ((READ-CHAR) (input-port/operation/read-char port))
- ((DISCARD-CHAR) (input-port/operation/discard-char port))
- ((READ-STRING) (input-port/operation/read-string port))
- ((DISCARD-CHARS) (input-port/operation/discard-chars port))
- ((READ-SUBSTRING) (input-port/operation/read-substring port))
- ((WRITE-CHAR) (output-port/operation/write-char port))
- ((WRITE-SUBSTRING) (output-port/operation/write-substring port))
- ((FLUSH-OUTPUT) (output-port/operation/flush-output port))
- ((DISCRETIONARY-FLUSH-OUTPUT)
- (output-port/operation/discretionary-flush port))
- (else false)))))
-
-(define ((closer name) port)
- (let ((operation (port/operation port name)))
- (if operation
- (operation port))))
-
-(define close-port (closer 'CLOSE))
-(define close-input-port (closer 'CLOSE-INPUT))
-(define close-output-port (closer 'CLOSE-OUTPUT))
-
+(define (close-port port)
+ (let ((close (port/operation port 'CLOSE)))
+ (if close
+ (close port)
+ (begin
+ (close-output-port port)
+ (close-input-port port)))))
+
+(define (close-input-port port)
+ (let ((close-input (port/operation port 'CLOSE-INPUT)))
+ (if close-input
+ (close-input port))))
+
+(define (close-output-port port)
+ (let ((close-output (port/operation port 'CLOSE-OUTPUT)))
+ (if close-output
+ (close-output port))))
+\f
(define (port/input-channel port)
(let ((operation (port/operation port 'INPUT-CHANNEL)))
(and operation
(and operation
(operation port))))
-;; These names for upwards compatibility:
-(define input-port/channel port/input-channel)
-(define input-port/copy port/copy)
-(define input-port/operation-names port/operation-names)
-(define input-port/state port/state)
-(define set-input-port/state! set-port/state!)
-(define output-port/channel port/output-channel)
-(define output-port/copy port/copy)
-(define output-port/operation-names port/operation-names)
-(define output-port/state port/state)
-(define set-output-port/state! set-port/state!)
-\f
+(define (port/operation port name)
+ (port-type/operation (port/type port) name))
+
(define (input-port/operation port name)
(port/operation port
(case name
((CHANNEL) 'OUTPUT-CHANNEL)
(else name))))
-(define input-port/custom-operation input-port/operation)
-(define output-port/custom-operation output-port/operation)
-
(define (input-port? object)
(and (port? object)
- (input-port/operation/read-char object)
- #t))
+ (port-type/supports-input? (port/type object))))
(define (output-port? object)
(and (port? object)
- (output-port/operation/write-char object)
- #t))
+ (port-type/supports-output? (port/type object))))
(define (i/o-port? object)
(and (port? object)
- (input-port/operation/read-char object)
- (output-port/operation/write-char object)
- #t))
+ (let ((type (port/type object)))
+ (and (port-type/supports-input? type)
+ (port-type/supports-output? type)))))
(define (guarantee-input-port port)
(if (not (input-port? port))
\f
;;;; Constructors
-(define (make-input-port operations state)
- (make-port operations state 'MAKE-INPUT-PORT true false))
+(define (make-input-port type state)
+ (make-port (if (port-type? type) type (make-input-port-type type #f)) state))
-(define (make-output-port operations state)
- (make-port operations state 'MAKE-OUTPUT-PORT false true))
+(define (make-output-port type state)
+ (make-port (if (port-type? type) type (make-output-port-type type #f))
+ state))
-(define (make-i/o-port operations state)
- (make-port operations state 'MAKE-I/O-PORT true true))
+(define (make-i/o-port type state)
+ (make-port (if (port-type? type) type (make-i/o-port-type type #f)) state))
(define make-port
- (let ((constructor
- (record-constructor
- port-rtd
- '(STATE THREAD-MUTEX OPERATION-NAMES CUSTOM-OPERATIONS))))
- (lambda (operations state procedure-name input? output?)
- (let ((port
- (constructor state
- (make-thread-mutex)
- '()
- (parse-operations-list operations procedure-name))))
- (install-input-operations! port input?)
- (install-output-operations! port output?)
- (set-port/operation-names! port
- (map* (port/operation-names port)
- car
- (port/custom-operations port)))
- port))))
+ (let ((constructor (record-constructor port-rtd '(TYPE STATE THREAD-MUTEX))))
+ (lambda (type state)
+ (guarantee-port-type type 'MAKE-PORT)
+ (constructor type state (make-thread-mutex)))))
+
+(define (make-input-port-type operations type)
+ (operations->port-type operations type 'MAKE-INPUT-PORT-TYPE #t #f))
+
+(define (make-output-port-type operations type)
+ (operations->port-type operations type 'MAKE-OUTPUT-PORT-TYPE #f #t))
+
+(define (make-i/o-port-type operations type)
+ (operations->port-type operations type 'MAKE-I/O-PORT-TYPE #t #t))
+
+(define (operations->port-type operations type procedure-name input? output?)
+ (let ((type
+ (parse-operations-list
+ (append operations
+ (if type
+ (list-transform-negative (port-type/operations type)
+ (lambda (entry)
+ (assq (car entry) operations)))
+ '()))
+ procedure-name)))
+ (install-operations! type input?
+ input-operation-names
+ input-operation-modifiers
+ input-operation-defaults)
+ (install-operations! type output?
+ output-operation-names
+ output-operation-modifiers
+ output-operation-defaults)
+ type))
(define (parse-operations-list operations procedure)
(if (not (list? operations))
(error:wrong-type-argument operations "list" procedure))
- (map (lambda (operation)
- (if (not (and (pair? operation)
- (symbol? (car operation))
- (pair? (cdr operation))
- (procedure? (cadr operation))
- (null? (cddr operation))))
- (error:wrong-type-argument operation "port operation" procedure))
- (cons (car operation) (cadr operation)))
- operations))
+ (%make-port-type
+ (map (lambda (operation)
+ (if (not (and (pair? operation)
+ (symbol? (car operation))
+ (pair? (cdr operation))
+ (procedure? (cadr operation))
+ (null? (cddr operation))))
+ (error:wrong-type-argument operation "port operation" procedure))
+ (cons (car operation) (cadr operation)))
+ operations)))
+\f
+(define (install-operations! type install? names modifiers defaults)
+ (if install?
+ (let* ((operations
+ (map (lambda (name)
+ (extract-operation! type name))
+ names))
+ (defaults (defaults names operations)))
+ (for-each (lambda (modifier operation name)
+ (modifier
+ type
+ (or operation
+ (let ((entry (assq name defaults)))
+ (if (not entry)
+ (error "Must specify operation:" name))
+ (cadr entry)))))
+ modifiers
+ operations
+ names))
+ (begin
+ (for-each (lambda (name)
+ (if (extract-operation! type name)
+ (error "Illegal operation name:" name)))
+ names)
+ (for-each (lambda (modifier)
+ (modifier type #f))
+ modifiers))))
(define extract-operation!
- (let ((updater (record-updater port-rtd 'CUSTOM-OPERATIONS)))
- (lambda (port name)
- (let ((operations (port/custom-operations port)))
- (let ((operation (assq name operations)))
- (and operation
- (begin
- (updater port (delq! operation operations))
- (cdr operation))))))))
-\f
-;;;; Input Operations
-
-(define install-input-operations!
- (let ((operation-names
- '(CHAR-READY? PEEK-CHAR READ-CHAR
- DISCARD-CHAR READ-STRING DISCARD-CHARS READ-SUBSTRING)))
- (let ((updaters
- (map (lambda (name)
- (record-updater port-rtd name))
- operation-names)))
- (lambda (port install?)
- (if install?
- (let ((operations
- (map (lambda (name)
- (extract-operation! port name))
- operation-names)))
- (for-each (lambda (updater operation default name)
- (updater
- port
- (or operation
- default
- (error "Must specify operation:" name))))
- updaters
- operations
- (list default-operation/char-ready?
- false
- false
- (caddr operations)
- default-operation/read-string
- default-operation/discard-chars
- default-operation/read-substring)
- operation-names)
- (set-port/operation-names!
- port
- (append operation-names (port/operation-names port))))
- (begin
- (for-each (lambda (name)
- (if (extract-operation! port name)
- (error "Illegal operation name:" name)))
- operation-names)
- (for-each (lambda (updater)
- (updater port false))
- updaters)))))))
+ (let ((set-port-type/custom-operations!
+ (record-modifier port-type-rtd 'CUSTOM-OPERATIONS)))
+ (lambda (type name)
+ (let ((operation (assq name (port-type/custom-operations type))))
+ (and operation
+ (begin
+ (set-port-type/custom-operations!
+ type
+ (delq! operation (port-type/custom-operations type)))
+ (cdr operation)))))))
+
+(define (search-paired-lists key keys datums error?)
+ (if (pair? keys)
+ (if (eq? key (car keys))
+ (car datums)
+ (search-paired-lists key (cdr keys) (cdr datums) error?))
+ (and error?
+ (error "Unable to find key:" key))))
\f
+;;;; Default Operations
+
+(define (input-operation-defaults names operations)
+ `((CHAR-READY? ,default-operation/char-ready?)
+ (DISCARD-CHAR ,(search-paired-lists 'READ-CHAR names operations #t))
+ (DISCARD-CHARS ,default-operation/discard-chars)
+ (READ-STRING ,default-operation/read-string)
+ (READ-SUBSTRING ,default-operation/read-substring)))
+
(define (default-operation/char-ready? port interval)
port interval
- true)
+ #t)
(define (default-operation/read-string port delimiters)
- (let ((peek-char (input-port/operation/peek-char port))
- (discard-char (input-port/operation/discard-char port)))
- (let ((peek-char (lambda () (let loop () (or (peek-char port) (loop))))))
- (let ((char (peek-char)))
- (if (eof-object? char)
- char
- (list->string
- (let loop ((char char))
- (if (or (eof-object? char)
- (char-set-member? delimiters char))
- '()
- (begin
- (discard-char port)
- (cons char (loop (peek-char))))))))))))
+ (let ((peek-char
+ (lambda () (let loop () (or (input-port/peek-char port) (loop))))))
+ (let ((char (peek-char)))
+ (if (eof-object? char)
+ char
+ (list->string
+ (let loop ((char char))
+ (if (or (eof-object? char)
+ (char-set-member? delimiters char))
+ '()
+ (begin
+ (input-port/discard-char port)
+ (cons char (loop (peek-char)))))))))))
(define (default-operation/discard-chars port delimiters)
- (let ((peek-char (input-port/operation/peek-char port))
- (discard-char (input-port/operation/discard-char port)))
- (let loop ()
- (let ((char
- (let loop ()
- (or (peek-char port)
- (loop)))))
- (if (not (or (eof-object? char)
- (char-set-member? delimiters char)))
- (begin
- (discard-char port)
- (loop)))))))
+ (let loop ()
+ (let ((char (let loop () (or (input-port/peek-char port) (loop)))))
+ (if (not (or (eof-object? char)
+ (char-set-member? delimiters char)))
+ (begin
+ (input-port/discard-char port)
+ (loop))))))
(define (default-operation/read-substring port string start end)
- (let ((read-char (input-port/operation/read-char port)))
- (let loop ((index start))
- (if (fix:< index end)
- (let ((char (read-char port)))
- (cond ((not char)
- (if (fix:= index start)
- #f
- (fix:- index start)))
- ((eof-object? char)
- (fix:- index start))
- (else
- (string-set! string index char)
- (loop (fix:+ index 1)))))
- (fix:- index start)))))
-\f
-;;;; Output Operations
+ (let loop ((index start))
+ (if (fix:< index end)
+ (let ((char (input-port/read-char port)))
+ (cond ((not char)
+ (if (fix:= index start)
+ #f
+ (fix:- index start)))
+ ((eof-object? char)
+ (fix:- index start))
+ (else
+ (string-set! string index char)
+ (loop (fix:+ index 1)))))
+ (fix:- index start))))
+
+(define (output-operation-defaults names operations)
+ (if (not (or (search-paired-lists 'WRITE-CHAR names operations #f)
+ (search-paired-lists 'WRITE-SUBSTRING names operations #f)))
+ (error "Must specify at least one of the following:"
+ '(WRITE-CHAR WRITE-SUBSTRING)))
+ `((DISCRETIONARY-FLUSH-OUTPUT ,default-operation/flush-output)
+ (FLUSH-OUTPUT ,default-operation/flush-output)
+ (FRESH-LINE ,default-operation/fresh-line)
+ (WRITE-CHAR ,default-operation/write-char)
+ (WRITE-SUBSTRING ,default-operation/write-substring)))
(define (default-operation/write-char port char)
- ((output-port/operation/write-substring port) port (string char) 0 1))
+ (output-port/write-substring port (string char) 0 1))
(define (default-operation/write-substring port string start end)
- (let ((write-char (output-port/operation/write-char port)))
- (let loop ((index start))
- (if (< index end)
- (begin
- (write-char port (string-ref string index))
- (loop (+ index 1)))))))
+ (let loop ((index start))
+ (if (< index end)
+ (begin
+ (output-port/write-char port (string-ref string index))
+ (loop (+ index 1))))))
+
+(define (default-operation/fresh-line port)
+ (output-port/write-char port #\newline))
(define (default-operation/flush-output port)
port
unspecific)
-
-(define install-output-operations!
- (let ((operation-names
- '(WRITE-CHAR WRITE-SUBSTRING FLUSH-OUTPUT DISCRETIONARY-FLUSH-OUTPUT))
- (operation-defaults
- (list default-operation/write-char
- default-operation/write-substring
- default-operation/flush-output
- default-operation/flush-output)))
- (let ((updaters
- (map (lambda (name)
- (record-updater port-rtd name))
- operation-names)))
- (lambda (port install?)
- (if install?
- (let ((operations
- (map (lambda (name)
- (extract-operation! port name))
- operation-names)))
- (if (not (or (car operations) (cadr operations)))
- (error "Must specify at least one of the following:"
- '(WRITE-CHAR WRITE-SUBSTRING)))
- (for-each (lambda (updater operation default)
- (updater port (or operation default)))
- updaters
- operations
- operation-defaults)
- (set-port/operation-names! port
- (append operation-names
- (port/operation-names port))))
- (begin
- (for-each (lambda (name)
- (if (extract-operation! port name)
- (error "Illegal operation name:" name)))
- operation-names)
- (for-each (lambda (updater)
- (updater port false))
- updaters)))))))
\f
;;;; Special Operations
(let ((operation (port/operation port 'INPUT-BLOCKING-MODE)))
(if operation
(operation port)
- false)))
+ #f)))
(define (port/set-input-blocking-mode port mode)
(let ((operation (port/operation port 'SET-INPUT-BLOCKING-MODE)))
(let ((operation (port/operation port 'OUTPUT-BLOCKING-MODE)))
(if operation
(operation port)
- false)))
+ #f)))
(define (port/set-output-blocking-mode port mode)
(let ((operation (port/operation port 'SET-OUTPUT-BLOCKING-MODE)))
(let ((operation (port/operation port 'INPUT-TERMINAL-MODE)))
(if operation
(operation port)
- false)))
+ #f)))
(define (port/set-input-terminal-mode port mode)
(let ((operation (port/operation port 'SET-INPUT-TERMINAL-MODE)))
(let ((operation (port/operation port 'OUTPUT-TERMINAL-MODE)))
(if operation
(operation port)
- false)))
+ #f)))
(define (port/set-output-terminal-mode port mode)
(let ((operation (port/operation port 'SET-OUTPUT-TERMINAL-MODE)))
(cons current-output-port set-current-output-port!)
(cons notification-output-port set-notification-output-port!)
(cons trace-output-port set-trace-output-port!)
- (cons interaction-i/o-port set-interaction-i/o-port!)))
\ No newline at end of file
+ (cons interaction-i/o-port set-interaction-i/o-port!)))
+\f
+;;;; Upwards Compatibility
+
+(define input-port/channel port/input-channel)
+(define input-port/copy port/copy)
+(define input-port/custom-operation input-port/operation)
+(define input-port/operation-names port/operation-names)
+(define input-port/state port/state)
+(define output-port/channel port/output-channel)
+(define output-port/copy port/copy)
+(define output-port/custom-operation output-port/operation)
+(define output-port/operation-names port/operation-names)
+(define output-port/state port/state)
+(define set-input-port/state! set-port/state!)
+(define set-output-port/state! set-port/state!)
\ No newline at end of file
projects / mit-scheme.git / commitdiff