From c57b52eb700b1f419f28d9a916b5881cfe06026f Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 12 Feb 2019 12:11:17 -0700 Subject: [PATCH] io: convert make-input-port to object style Sortof. This is where we especially take advantage of vtable flexibility. The methods of the vtable are really closures, because that's far more convenient for custom ports. --- racket/src/io/port/custom-input-port.rkt | 75 ++++++++++++----------- racket/src/io/port/nowhere.rkt | 19 +++--- racket/src/io/port/output-port.rkt | 2 +- racket/src/io/port/peek-via-read-port.rkt | 12 +++- 4 files changed, 58 insertions(+), 50 deletions(-) diff --git a/racket/src/io/port/custom-input-port.rkt b/racket/src/io/port/custom-input-port.rkt index a9a377aeff..cf0edef1bc 100644 --- a/racket/src/io/port/custom-input-port.rkt +++ b/racket/src/io/port/custom-input-port.rkt @@ -260,40 +260,41 @@ (make-buffer-mode user-buffer-mode))) (cond - [user-peek-in - (make-core-input-port - #:name name - #:self #f - #:read-in - (if (input-port? user-read-in) - user-read-in - read-in) - #:peek-in - (if (input-port? user-peek-in) - user-peek-in - peek-in) - #:byte-ready - (if (input-port? user-peek-in) - user-peek-in - byte-ready) - #:close close - #:get-progress-evt (and user-get-progress-evt get-progress-evt) - #:commit (and user-commit commit) - #:get-location get-location - #:count-lines! count-lines! - #:init-offset init-offset - #:file-position file-position - #:buffer-mode buffer-mode)] - [else - (define-values (port buffer-flusher) - (open-input-peek-via-read - #:name name - #:self #f - #:read-in read-in - #:close close - #:get-location get-location - #:count-lines! count-lines! - #:init-offset init-offset - #:file-position file-position - #:alt-buffer-mode buffer-mode)) - port])) + [user-peek-in + (new core-input-port + #:override + ([read-in (if (input-port? user-read-in) + user-read-in + read-in)] + [peek-in (if (input-port? user-peek-in) + user-peek-in + peek-in)] + [byte-ready (if (input-port? user-peek-in) + user-peek-in + byte-ready)] + [close close] + [get-progress-evt (and user-get-progress-evt get-progress-evt)] + [commit (and user-commit commit)] + [get-location get-location] + [count-lines! count-lines!] + [file-position file-position] + [buffer-mode buffer-mode]) + [name name] + [offset init-offset])] + [else + (new peek-via-read-input-port + #:override + ([read-in/inner read-in] + [close (values + (lambda (self) + (close self) + (send peek-via-read-input-port self close-peek-buffer)))] + [get-location get-location] + [count-lines! count-lines!] + [file-position file-position] + [buffer-mode (or buffer-mode + (case-lambda + [(self) (send peek-via-read-input-port self default-buffer-mode)] + [(self mode) (send peek-via-read-input-port self default-buffer-mode mode)]))]) + [name name] + [offset init-offset])])) diff --git a/racket/src/io/port/nowhere.rkt b/racket/src/io/port/nowhere.rkt index f149a7a408..9620150a50 100644 --- a/racket/src/io/port/nowhere.rkt +++ b/racket/src/io/port/nowhere.rkt @@ -1,14 +1,15 @@ #lang racket/base -(require "output-port.rkt") +(require "../common/class.rkt" + "output-port.rkt") (provide open-output-nowhere) +(class nowhere-output-port #:extends core-output-port + (override + [write-out-special + (lambda (any no-block/buffer? enable-break?) + #t)])) + (define (open-output-nowhere) - (make-core-output-port #:name 'nowhere - #:self #f - #:evt always-evt - #:write-out (lambda (self bstr start-k end-k no-block/buffer? enable-break? copy?) - (- end-k start-k)) - #:close void - #:write-out-special (lambda (self any no-block/buffer? enable-break?) - #t))) + (new nowhere-output-port + [name 'nowhere])) diff --git a/racket/src/io/port/output-port.rkt b/racket/src/io/port/output-port.rkt index 90af0aefe7..7f2efab6f3 100644 --- a/racket/src/io/port/output-port.rkt +++ b/racket/src/io/port/output-port.rkt @@ -67,7 +67,7 @@ ;; The return values are the same as documented for ;; `make-output-port`. [write-out (lambda (bstr start-k end-k no-block/buffer? enable-break? copy?) - (- start-k end-k))] + (- end-k start-k))] ;; #f or (any no-block/buffer? enable-break? -*> boolean?) ;; Called in atomic mode. diff --git a/racket/src/io/port/peek-via-read-port.rkt b/racket/src/io/port/peek-via-read-port.rkt index 4ffa902513..24486c6a67 100644 --- a/racket/src/io/port/peek-via-read-port.rkt +++ b/racket/src/io/port/peek-via-read-port.rkt @@ -41,7 +41,13 @@ [buffer-adjust-pos (lambda (i) - (- i (fx- end-pos (if buffer buffer-pos pos))))]) + (- i (fx- end-pos (if buffer buffer-pos pos))))] + + ;; in atomic mode + [default-buffer-mode + (case-lambda + [() buffer-mode] + [(mode) (set! buffer-mode mode)])]) (private ;; in atomic mode @@ -218,8 +224,8 @@ ;; in atomic mode [buffer-mode (case-lambda - [(self) buffer-mode] - [(self mode) (set! buffer-mode mode)])] + [() (default-buffer-mode)] + [(mode) (default-buffer-mode mode)])] ;; in atomic mode [close