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

56
lib/srfi/38.scm
View file

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