suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

io: convert make-input-port to object style

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2019-02-12 12:11:17 -07:00
parent 6e85165b3c
commit c57b52eb70
4 changed files with 58 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
racket/src/io/port/custom-input-port.rkt
View File

@ -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])]))

19
racket/src/io/port/nowhere.rkt
View File

@ -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]))

2
racket/src/io/port/output-port.rkt
View File

@ -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.

12
racket/src/io/port/peek-via-read-port.rkt
View File

@ -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