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) (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 put-u8 put-char put-string put-bytevector
get-char get-u8 lookahead-u8 get-char get-u8 lookahead-u8
get-string-n get-string-n! get-string-n get-string-n!
@ -27,7 +27,7 @@
(ikarus system $io) (ikarus system $io)
(ikarus system $fx) (ikarus system $fx)
(ikarus system $ports) (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 put-u8 put-char put-string put-bytevector
get-char get-u8 lookahead-u8 get-char get-u8 lookahead-u8
get-string-n get-string-n! get-string-n get-string-n!
@ -134,18 +134,6 @@
($read-char p) ($read-char p)
(error 'read-char "not an input-port" 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 (define peek-char
(case-lambda (case-lambda
[() ($peek-char (current-input-port))] [() ($peek-char (current-input-port))]

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

@ -16,7 +16,7 @@
(library (ikarus io-primitives unsafe) (library (ikarus io-primitives unsafe)
(export $write-char $write-byte $read-char $get-u8 $lookahead-u8 (export $write-char $write-byte $read-char $get-u8 $lookahead-u8
$unread-char $peek-char $peek-char
$reset-input-port! $flush-output-port $reset-input-port! $flush-output-port
$close-input-port $close-output-port) $close-input-port $close-output-port)
(import (import
@ -103,18 +103,6 @@
[else (($port-handler p) 'peek-char p)])) [else (($port-handler p) 'peek-char p)]))
(($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! (define $reset-input-port!
(lambda (p) (lambda (p)
($set-port-size! p 0))) ($set-port-size! p 0)))

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

@ -91,9 +91,6 @@
(define peek-multibyte-char (define peek-multibyte-char
(lambda (p) (lambda (p)
(error 'peek-multibyte-char "not implemented"))) (error 'peek-multibyte-char "not implemented")))
(define unread-multibyte-char
(lambda (c p)
(error 'unread-multibyte-char "not implemented")))
(define make-input-file-handler (define make-input-file-handler
(lambda (fd port-name) (lambda (fd port-name)
@ -188,22 +185,6 @@
[else [else
($bytevector-u8-ref ($port-buffer p) 0)])) ($bytevector-u8-ref ($port-buffer p) 0)]))
(error 'lookahead-u8 "port is closed" p))))] (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] [(port-name p) port-name]
[(close-port p) [(close-port p)
(unless (input-port? p) (unless (input-port? p)

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

@ -68,14 +68,6 @@
(if open? (if open?
(eof-object) (eof-object)
(error 'peek-char "port is closed" p)))] (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*] [(port-name p) '*string-port*]
[(close-port p) [(close-port p)
(when open? (when open?

52
scheme/ikarus.reader.ss
View File

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