conservatory
/
ikarus
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* input strings now do not use the internal port buffer

This commit is contained in:
Abdulaziz Ghuloum 2007-05-17 05:50:01 -04:00
parent 49dc13d5ee
commit efd2734075
2 changed files with 18 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
src/ikarus.boot
View File

Binary file not shown.

47
src/ikarus.io.input-strings.ss
View File

@ -33,45 +33,34 @@
(define make-input-string-handler
(lambda (str)
(let ((open? #t))
(let ((open? #t) (idx 0) (n (string-length str)))
(lambda (msg . args)
(message-case msg args
[(read-char p)
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(begin
($set-port-input-index! p ($fxadd1 idx))
(string-ref ($port-input-buffer p) idx))
(if open?
(eof-object)
(error 'read-char "port ~s is closed" p))))]
(if ($fx< idx n)
(let ([c ($string-ref str idx)])
(set! idx ($fxadd1 idx))
c)
(if open?
(eof-object)
(error 'read-char "port ~s is closed" p)))]
[(peek-char p)
(unless (input-port? p)
(error 'peek-char "~s is not an input port" p))
(let ([idx ($port-input-index p)])
(if ($fx< idx ($port-input-size p))
(string-ref ($port-input-buffer p) idx)
(if open?
(eof-object)
(error 'peek-char "port ~s is closed" p))))]
(if ($fx< idx n)
($string-ref str idx)
(if open?
(eof-object)
(error 'peek-char "port ~s is closed" p)))]
[(unread-char c p)
(unless (input-port? p)
(error 'unread-char "~s is not an input port" p))
(let ([idx ($fxsub1 ($port-input-index p))])
(if (and ($fx>= idx 0)
($fx< idx ($port-input-size p)))
(begin
($set-port-input-index! p idx)
(string-set! ($port-input-buffer p) idx c))
(let ([i ($fxsub1 idx)])
(if (and ($fx>= i 0)
($fx< i n))
(set! idx i)
(if open?
(error 'unread-char "port ~s is closed" p)
(error 'unread-char "too many unread-chars"))))]
[(port-name p) '*string-port*]
[(close-port p)
(unless (input-port? p)
(error 'close-input-port "~s is not an input port" p))
(when open?
($set-port-input-size! p 0)
(set! open? #f))]
[else
(error 'input-string-handler
@ -83,7 +72,7 @@
(error 'open-input-string "~s is not a string" str))
(let ([port (make-input-port
(make-input-string-handler str)
str)])
"")])
port)))
)