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

The unread-char primitive is deleted, all code that referenced 

unread-char was rewritten as peek-char and read-char.
This commit is contained in:
Abdulaziz Ghuloum 2007-12-05 05:01:56 -05:00
parent e874d2d0a0
commit 0b693a7103
8 changed files with 39 additions and 95 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

BIN
scheme/ikarus.boot.prebuilt
View File

Binary file not shown.

16
scheme/ikarus.io-primitives.ss
View File

@ -15,7 +15,7 @@
(library (ikarus io-primitives)
(export read-char unread-char peek-char write-char write-byte
(export read-char peek-char write-char write-byte
put-u8 put-char put-string put-bytevector
get-char get-u8 lookahead-u8
get-string-n get-string-n!
@ -27,7 +27,7 @@
(ikarus system $io)
(ikarus system $fx)
(ikarus system $ports)
(except (ikarus) read-char unread-char peek-char write-char write-byte
(except (ikarus) read-char peek-char write-char write-byte
put-u8 put-char put-string put-bytevector
get-char get-u8 lookahead-u8
get-string-n get-string-n!
@ -134,18 +134,6 @@
($read-char p)
(error 'read-char "not an input-port" p))]))
;;;
(define unread-char
(case-lambda
[(c) (if (char? c)
($unread-char c (current-input-port))
(error 'unread-char "not a character" c))]
[(c p)
(if (input-port? p)
(if (char? c)
($unread-char c p)
(error 'unread-char "not a character" c))
(error 'unread-char "not an input-port" p))]))
;;;
(define peek-char
(case-lambda
[() ($peek-char (current-input-port))]

14
scheme/ikarus.io-primitives.unsafe.ss
View File

@ -16,7 +16,7 @@
(library (ikarus io-primitives unsafe)
(export $write-char $write-byte $read-char $get-u8 $lookahead-u8
$unread-char $peek-char
$peek-char
$reset-input-port! $flush-output-port
$close-input-port $close-output-port)
(import
@ -103,18 +103,6 @@
[else (($port-handler p) 'peek-char p)]))
(($port-handler p) 'peek-char p)))))
(define $unread-char
(lambda (c p)
(let ([idx ($fxsub1 ($port-index p))]
[b ($char->fixnum c)])
(if (and ($fx<= b 127)
($fx>= idx 0)
($fx< idx ($port-size p)))
(begin
($set-port-index! p idx)
($bytevector-set! ($port-buffer p) idx b))
(($port-handler p) 'unread-char c p)))))
(define $reset-input-port!
(lambda (p)
($set-port-size! p 0)))

19
scheme/ikarus.io.input-files.ss
View File

@ -91,9 +91,6 @@
(define peek-multibyte-char
(lambda (p)
(error 'peek-multibyte-char "not implemented")))
(define unread-multibyte-char
(lambda (c p)
(error 'unread-multibyte-char "not implemented")))
(define make-input-file-handler
(lambda (fd port-name)
@ -188,22 +185,6 @@
[else
($bytevector-u8-ref ($port-buffer p) 0)]))
(error 'lookahead-u8 "port is closed" p))))]
[(unread-char c p)
(unless (input-port? p)
(error 'unread-char "not an input port" p))
(let ([idx ($fxsub1 ($port-index p))]
[b (if (char? c)
($char->fixnum c)
(error 'unread-char "not a char" c))])
(if (and ($fx>= idx 0)
($fx< idx ($port-size p)))
(cond
[($fx< b 128)
($set-port-index! p idx)]
[else (unread-multibyte-char c p)])
(if open?
(error 'unread-char "port is closed" p)
(error 'unread-char "too many unread-chars"))))]
[(port-name p) port-name]
[(close-port p)
(unless (input-port? p)

8
scheme/ikarus.io.input-strings.ss
View File

@ -68,14 +68,6 @@
(if open?
(eof-object)
(error 'peek-char "port is closed" p)))]
[(unread-char c p)
(let ([i ($fxsub1 idx)])
(if (and ($fx>= i 0)
($fx< i n))
(set! idx i)
(if open?
(error 'unread-char "port is closed" p)
(error 'unread-char "too many unread-chars"))))]
[(port-name p) '*string-port*]
[(close-port p)
(when open?

52
scheme/ikarus.reader.ss
View File

@ -64,17 +64,17 @@
(memq c '(#\+ #\- #\. #\@))))
(define tokenize-identifier
(lambda (ls p)
(let ([c (read-char p)])
(let ([c (peek-char p)])
(cond
[(eof-object? c) ls]
[(subsequent? c)
(tokenize-identifier (cons c ls) p)]
(tokenize-identifier (cons (read-char p) ls) p)]
[(delimiter? c)
(unread-char c p)
ls]
[(char=? c #\\) (tokenize-backslash ls p)]
[(char=? c #\\)
(read-char p)
(tokenize-backslash ls p)]
[else
(unread-char c p)
(error 'tokenize "invalid identifier syntax"
(list->string (reverse (cons c ls))))]))))
(define (tokenize-string ls p)
@ -193,11 +193,12 @@
[(delimiter? c) 'dot]
[($char= c #\.) ; this is second dot
(read-char p)
(let ([c (read-char p)])
(let ([c (peek-char p)])
(cond
[(eof-object? c)
(error 'tokenize "invalid syntax .. near end of file")]
[($char= c #\.) ; this is the third
(read-char p)
(let ([c (peek-char p)])
(cond
[(eof-object? c) '(datum . ...)]
@ -206,7 +207,6 @@
(error 'tokenize "invalid syntax"
(string-append "..." (string c)))]))]
[else
(unread-char c p)
(error 'tokenize "invalid syntax"
(string-append ".." (string c)))]))]
[else
@ -296,15 +296,15 @@
(lambda (v)
(read-char p)
(let f ([v v])
(let ([c (read-char p)])
(let ([c (peek-char p)])
(cond
[(eof-object? c)
(cons 'datum (integer->char v))]
[(delimiter? c)
(unread-char c p)
(cons 'datum (integer->char v))]
[(hex c) =>
(lambda (v0)
(read-char p)
(f (+ (* v 16) v0)))]
[else
(error 'tokenize "invalid character sequence")]))))]
@ -539,7 +539,6 @@
(error 'read "FIXME: fasl read disabled")
'(cons 'datum ($fasl-read p))]
[else
(unread-char c p)
(error 'tokenize
(format "invalid syntax #~a" c))])))
(define (tokenize-exactness-mark p ls exact?)
@ -636,43 +635,47 @@
(tokenize-denom p (cons c ls) exact? radix num d))]
[else (num-error "invalid sequence" (cons c ls))])))
(define (tokenize-denom p ls exact? radix num ac)
(let ([c (read-char p)])
(let ([c (peek-char p)])
(cond
[(eof-object? c)
(read-char p)
(if (= ac 0)
(num-error "zero denominator" ls)
(convert/exact exact? (/ num ac)))]
[(radix-digit c radix) =>
(lambda (d)
(read-char p)
(tokenize-denom p (cons c ls) exact? radix num
(+ (* radix ac) d)))]
[(delimiter? c)
(unread-char c p)
(if (= ac 0)
(num-error "zero denominator" ls)
(convert/exact exact? (/ num ac)))]
[else (num-error "invalid sequence" (cons c ls))])))
(let ([c (read-char p)])
(let ([c (peek-char p)])
(cond
[(eof-object? c) (convert/exact exact? ac)]
[(radix-digit c radix) =>
(lambda (d)
(read-char p)
(tokenize-integer p (cons c ls) exact? radix
(+ (* ac radix) d)))]
[(char=? c #\.)
(unless (= radix 10)
(num-error "invalid decimal" (cons c ls)))
(read-char p)
(tokenize-decimal p (cons c ls) exact? ac 0)]
[(char=? c #\/)
(read-char p)
(tokenize-denom-start p (cons #\/ ls) exact? radix ac)]
[(memv c '(#\e #\E)) ; exponent
(read-char p)
(unless (= radix 10)
(num-error "invalid decimal" (cons c ls)))
(let ([ex (tokenize-exponent-start p (cons c ls))])
(convert/exact (or exact? 'i)
(* ac (expt radix ex))))]
[(delimiter? c)
(unread-char c p)
(convert/exact exact? ac)]
[else (num-error "invalid sequence" (cons c ls))])))
(define (tokenize-exponent-start p ls)
@ -685,16 +688,15 @@
(tokenize-exponent p (cons c ls) d))]
[else (num-error "invalid sequence" (cons c ls))])))
(define (tokenize-exponent p ls ac)
(let ([c (read-char p)])
(let ([c (peek-char p)])
(cond
[(eof-object? c) ac]
[(radix-digit c 10) =>
(lambda (d)
(read-char p)
(tokenize-exponent p (cons c ls)
(+ (* ac 10) d)))]
[(delimiter? c)
(unread-char c p)
ac]
[(delimiter? c) ac]
[else (num-error "invalid sequence" (cons c ls))])))
(let ([c (read-char p)])
(cond
@ -708,21 +710,22 @@
(tokenize-exponent-no-digits p (cons c ls))]
[else (num-error "invalid sequence" (cons c ls))])))
(define (tokenize-decimal p ls exact? ac exp)
(let ([c (read-char p)])
(let ([c (peek-char p)])
(cond
[(eof-object? c)
(let ([ac (* ac (expt 10 exp))])
(convert/exact (or exact? 'i) ac))]
[(radix-digit c 10) =>
(lambda (d)
(read-char p)
(tokenize-decimal p (cons c ls) exact?
(+ (* ac 10) d) (- exp 1)))]
[(memv c '(#\e #\E))
(read-char p)
(let ([ex (tokenize-exponent-start p (cons c ls))])
(let ([ac (* ac (expt 10 (+ exp ex)))])
(convert/exact (or exact? 'i) ac)))]
[(delimiter? c)
(unread-char c p)
(let ([ac (* ac (expt 10 exp))])
(convert/exact (or exact? 'i) ac))]
[else (num-error "invalid sequence" (cons c ls))])))
@ -777,8 +780,6 @@
(list->string (reverse (cons c ls))))))))]
[else
(let ([c (read-char p)])
(cond
[else
(cond
[(eof-object? c)
(error 'tokenize
@ -787,10 +788,9 @@
(and ci? (char=? (char-downcase c) (string-ref str i))))
(f (add1 i) (cons c ls))]
[else
(unread-char c p)
(error 'tokenize
(format "invalid ~a: ~s" who
(list->string (reverse (cons c ls)))))])]))])))
(list->string (reverse (cons c ls)))))]))])))
(define (tokenize-integer/nan/inf-no-digits p ls)
(let ([c (read-char p)])
(cond
@ -832,7 +832,6 @@
[(digit? c)
(tokenize-hashnum p (fx+ (fx* n 10) (char->num c)))]
[else
(unread-char c p)
(error 'tokenize "invalid char while inside a #n mark/ref" c)])))
(define tokenize-bar
(lambda (p ac)
@ -876,11 +875,9 @@
(error 'tokenize "invalid sequence"
(list->string (cons c (reverse ac))))]))))]
[else
(unread-char c p)
(error 'tokenize
(format "invalid sequence \\x~a" c))]))]
[else
(unread-char c p)
(error 'tokenize
(format "invalid sequence \\~a" c))])))
(define tokenize/c
@ -950,7 +947,6 @@
(list->string
(reverse (tokenize-backslash '() p)))))]
[else
(unread-char c p)
(error 'tokenize "invalid syntax" c)])))
(define tokenize

2
scheme/last-revision
View File

@ -1 +1 @@
1186
1187

3
scheme/makefile.ss
View File

@ -354,7 +354,7 @@
[reset-input-port! i]
[write-byte i]
[read-token i]
[unread-char i]
;[unread-char i]
[printf i]
[fprintf i]
[format i]
@ -540,7 +540,6 @@
[$write-byte $io]
[$read-char $io]
[$peek-char $io]
[$unread-char $io]
[$arg-list $arg-list]
[$collect-key $arg-list]
[$$apply $stack]