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

fixing write/ss output

Browse source
This commit is contained in:
Alex Shinn 2011-10-30 23:09:08 +09:00
parent 8c93158dd5
commit e2b0a9f8dd
1 changed files with 33 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
lib/srfi/38.scm
View file

@ -38,11 +38,12 @@
(else
(cond (cell
(display prefix out)
(display "#=" out)
(display "#" out)
(write count out)
(display "=" out)
(set-cdr! cell count)
(set! count (+ count 1))))
(cont x)))))
(cont x cell)))))
(cond
((null? shared)
(write x out))
@ -51,7 +52,7 @@
(check-shared
x
""
(lambda (x)
(lambda (x shared?)
(cond
((pair? x)
(display "(" out)
@ -60,12 +61,22 @@
(check-shared
ls
" . "
(lambda (ls)
(lambda (ls shared?)
(cond ((null? ls))
((pair? ls)
(cond
(shared?
(display "(" out)
(wr (car ls))
(check-shared
(cdr ls)
" . "
(lambda (ls shared?) (lp ls)))
(display ")" out))
(else
(display " " out)
(wr (car ls))
(lp (cdr ls)))
(lp (cdr ls)))))
(else
(display " . " out)
(wr ls))))))
@ -188,26 +199,25 @@
((#\#)
(read-char in)
(case (char-downcase (peek-char in))
((#\=)
(read-char in)
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
(let* ((str (read-label '()))
(n (string->number str))
(cell (list #f))
(thunk (lambda () (car cell))))
(n (string->number str)))
(if (not n) (error "read error: invalid reference" str))
(cond
((eqv? #\= (peek-char in))
(read-char in)
(let* ((cell (list #f))
(thunk (lambda () (car cell))))
(set! shared (cons (cons n thunk) shared))
(let ((x (read-one)))
(set-car! cell x)
x)))
((#\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9)
(let ((n (string->number (read-label '()))))
(cond
((not (eqv? #\# (peek-char in)))
(error "read error: expected # after #n" (read-char in)))
(else
((eqv? #\# (peek-char in))
(read-char in)
(cond ((assv n shared) => cdr)
(else (error "read error: unknown reference" n)))))))
(else (error "read error: unknown reference" n))))
(else
(error "read error: expected # after #n" (read-char in))))))
((#\;)
(read-char in)
(read-one) ;; discard