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

Fixing #; comments as the last element in a list for (scheme read).

Browse source
This commit is contained in:
Alex Shinn 2015-06-13 21:57:31 +09:00
parent a05b94f3c2
commit eab76ce8c1
2 changed files with 147 additions and 136 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

65
lib/srfi/38.scm
View file

@ -259,12 +259,8 @@
(else
(slot-set! type res i (car ls))
(lp (cdr ls) (+ i 1)))))))
(else (lp (cons (read-one) ls))))))))
(define (read-one)
(skip-whitespace in)
(case (peek-char in)
((#\#)
(read-char in)
(else (lp (cons (read-one in) ls))))))))
(define (read-hash in)
(if (eof-object? (peek-char in))
(read-error "read error: incomplete # found at end of input"))
(case (char-downcase (peek-char in))
@ -278,7 +274,7 @@
(let* ((cell (list #f))
(thunk (lambda () (car cell))))
(set! shared (cons (cons n thunk) shared))
(let ((x (read-one)))
(let ((x (read-one in)))
(set-car! cell x)
x)))
((eqv? #\# (peek-char in))
@ -291,18 +287,18 @@
(read-char in))))))
((#\;)
(read-char in)
(read-one) ;; discard
(read-one))
(read-one in) ;; discard
(read-one in))
((#\|)
(skip-comment in 0)
(read-one))
(read-one in))
((#\!)
(read-char in)
(let ((c (peek-char in)))
(cond
((or (char-whitespace? c) (eqv? c #\/))
(skip-line in)
(read-one))
(read-one in))
(else
(let ((name (read-name #f in)))
(cond
@ -312,10 +308,10 @@
(set-port-fold-case! in #f))
(else ;; assume a #!/bin/bash line
(read-error "unknown #! symbol" name)))
(read-one))))))
((#\() (list->vector (read-one)))
((#\') (read-char in) (list 'syntax (read-one)))
((#\`) (read-char in) (list 'quasisyntax (read-one)))
(read-one in))))))
((#\() (list->vector (read-one in)))
((#\') (read-char in) (list 'syntax (read-one in)))
((#\`) (read-char in) (list 'quasisyntax (read-one in)))
((#\t) (let ((s (read-name #f in)))
(or (string-ci=? s "t") (string-ci=? s "true")
(read-error "bad # syntax" s))))
@ -327,7 +323,7 @@
((#\x) (read-char in) (read-number 16))
((#\o) (read-char in) (read-number 8))
((#\b) (read-char in) (read-number 2))
((#\i) (read-char in) (exact->inexact (read-one)))
((#\i) (read-char in) (exact->inexact (read-one in)))
((#\e) (string->number (read-name #\# in)))
((#\u #\v)
(if (eqv? #\v (peek-char in))
@ -336,7 +332,7 @@
(if (not (eqv? #\8 (peek-char in)))
(read-error "invalid syntax #u" (peek-char in)))
(read-char in)
(let ((ls (read-one)))
(let ((ls (read-one in)))
(if (not (list? ls))
(read-error "invalid bytevector syntax" ls))
(let* ((len (length ls))
@ -353,10 +349,22 @@
(read-named-char c1 in))))
(else
(read-error "unknown # syntax: " (peek-char in)))))
(define (read-one in)
(cond
((not (skip-whitespace-and-sexp-comments in read-one))
(read-hash in))
(else
(case (peek-char in)
((#\#)
(read-char in)
(read-hash in))
((#\()
(read-char in)
(let lp ((res '()))
(skip-whitespace in)
(cond
((not (skip-whitespace-and-sexp-comments in read-one))
(lp (cons (read-hash in) res)))
(else
(let ((c (peek-char in)))
(case c
((#\))
@ -366,15 +374,18 @@
(read-char in)
(cond
((memv (peek-char in) delimiters)
(let ((tail (read-one)))
(let ((tail (read-one in)))
(cond
((null? res)
(read-error "dot before any elements in list"))
((and (skip-whitespace-and-sexp-comments
in (lambda (in) (read-one)))
in read-one)
(eqv? #\) (peek-char in)))
(read-char in)
(append (reverse res) tail))
((eof-object? (peek-char in))
(read-incomplete-error "unterminated dotted list"))
(read-incomplete-error
"unterminated dotted list"))
(else
(read-error "expected end of list after dot")))))
((char-numeric? (peek-char in))
@ -384,22 +395,22 @@
(else
(if (eof-object? c)
(read-incomplete-error "unterminated list")
(lp (cons (read-one) res))))))))
(lp (cons (read-one in) res))))))))))
((#\{)
(read-char in)
(read-object))
((#\') (read-char in) (list 'quote (read-one)))
((#\`) (read-char in) (list 'quasiquote (read-one)))
((#\') (read-char in) (list 'quote (read-one in)))
((#\`) (read-char in) (list 'quasiquote (read-one in)))
((#\,)
(read-char in)
(let ((sym (if (eqv? #\@ (peek-char in))
(begin (read-char in) 'unquote-splicing)
'unquote)))
(list sym (read-one))))
(list sym (read-one in))))
(else
(read in))))
(read in))))))
;; body
(let ((res (read-one)))
(let ((res (read-one in)))
(if (pair? shared)
(patch res))
res)))))

2
tests/r7rs-tests.scm
View file

@ -2040,7 +2040,7 @@
(test '(a . b) (read (open-input-string "(a . b #;c)")))
(define (test-read-error str)
(test-assert
(test-assert str
(guard (exn (else #t))
(read (open-input-string str))
#f)))