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

switch to #lang

Browse Source 
svn: r16469
This commit is contained in:
Eli Barzilay 2009-10-30 08:01:43 +00:00
parent 27f1489403
commit bfb3fd2d67
1 changed files with 82 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/scheme/port.ss
View File

@ -1,5 +1,5 @@
#lang scheme/base
(module port scheme/base
(require mzlib/port
"private/portlines.ss")
(provide (except-out (all-from-out mzlib/port)
@ -22,11 +22,8 @@
call-with-input-bytes)
(define (port->string-port who p)
(unless (input-port? p)
(raise-type-error who "input-port" p))
(let ([s (open-output-string)])
(copy-port p s)
s))
(unless (input-port? p) (raise-type-error who "input-port" p))
(let ([s (open-output-string)]) (copy-port p s) s))
(define (port->string [p (current-input-port)])
(get-output-string (port->string-port 'port->string p)))
@ -43,21 +40,17 @@
(define (port->list [r read] [p (current-input-port)])
(unless (input-port? p)
(raise-type-error 'port->list "input-port" p))
(unless (and (procedure? r)
(procedure-arity-includes? r 1))
(unless (and (procedure? r) (procedure-arity-includes? r 1))
(raise-type-error 'port->list "procedure (arity 1)" r))
(for/list ([v (in-port r p)]) v))
(define (display-lines l [p (current-output-port)] #:separator [newline #"\n"])
(unless (list? l)
(raise-type-error 'display-lines "list" l))
(unless (output-port? p)
(raise-type-error 'display-lines "output-port" p))
(unless (list? l) (raise-type-error 'display-lines "list" l))
(unless (output-port? p) (raise-type-error 'display-lines "output-port" p))
(do-lines->port l p newline))
(define (with-output-to-x who n proc)
(unless (and (procedure? proc)
(procedure-arity-includes? proc n))
(unless (and (procedure? proc) (procedure-arity-includes? proc n))
(raise-type-error who (format "procedure (arity ~a)" n) proc))
(let ([s (open-output-bytes)])
;; Use `dup-output-port' to hide string-port-ness of s:
@ -82,8 +75,7 @@
(define (with-input-from-x who n b? str proc)
(unless (if b? (bytes? str) (string? str))
(raise-type-error who (if b? "byte string" "string") 0 str proc))
(unless (and (procedure? proc)
(procedure-arity-includes? proc n))
(unless (and (procedure? proc) (procedure-arity-includes? proc n))
(raise-type-error who (format "procedure (arity ~a)" n) 1 str proc))
(let ([s (if b? (open-input-bytes str) (open-input-string str))])
(if (zero? n)
@ -101,5 +93,4 @@
(with-input-from-x 'call-with-input-string 1 #f str proc))
(define (call-with-input-bytes str proc)
(with-input-from-x 'call-with-input-bytes 1 #t str proc)))
(with-input-from-x 'call-with-input-bytes 1 #t str proc))