Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 21:59:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixing bug reading unnamed chars at eof.

Browse source 
Adding support for R7RS extended char names.
This commit is contained in:
Alex Shinn 2012-03-08 07:11:00 +09:00
parent 4cf1e72625
commit ae203e2e82
1 changed files with 19 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

27
lib/srfi/38.scm
View file

@ -137,7 +137,18 @@
(skip-comment in depth))))) (skip-comment in depth)))))
(define delimiters (define delimiters
'(#\( #\) #\{ #\} #\space #\tab #\newline #\return)) '(#\; #\( #\) #\{ #\} #\space #\tab #\newline #\return))
(define named-chars
`(("newline" . #\newline)
("return" . #\return)
("space" . #\space)
("tab" . #\tab)
("null" . ,(integer->char 0))
("alarm" . ,(integer->char 7))
("backspace" . ,(integer->char 8))
("escape" . ,(integer->char 27))
("delete" . ,(integer->char 127))))
(define read-with-shared-structure (define read-with-shared-structure
(let ((read read)) (let ((read read))
@ -174,9 +185,8 @@
(else (lp (cons (read-char in) ls))))))) (else (lp (cons (read-char in) ls)))))))
(define (read-named-char c in) (define (read-named-char c in)
(let ((name (read-name c in))) (let ((name (read-name c in)))
(cond ((string-ci=? name "space") #\space) (cond ((assoc name named-chars string-ci=?) => cdr)
((string-ci=? name "newline") #\newline) (else (error "unknown char name" name)))))
(else (error "unknown char name")))))
(define (read-type-id in) (define (read-type-id in)
(let ((ch (peek-char in))) (let ((ch (peek-char in)))
(cond (cond
@ -272,10 +282,11 @@
((#\e) (read-char in) (inexact->exact (read-one))) ((#\e) (read-char in) (inexact->exact (read-one)))
((#\\) ((#\\)
(read-char in) (read-char in)
(let ((c (read-char in))) (let* ((c1 (read-char in))
(if (memv (peek-char in) delimiters) (c2 (peek-char in)))
c (if (or (eof-object? c2) (memv c2 delimiters))
(read-named-char c in)))) c1
(read-named-char c1 in))))
(else (else
(error "unknown # syntax: " (peek-char in))))) (error "unknown # syntax: " (peek-char in)))))
((#\() ((#\()