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

Using brace-notation for write/ss for records not containing any shares.

Browse source
This commit is contained in:
Alex Shinn 2012-06-02 20:11:54 +09:00
parent a56b497a00
commit befe63d6ba
1 changed files with 47 additions and 51 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

98
lib/srfi/38.scm
View file

@ -55,58 +55,54 @@
(set-cdr! cell count) (set-cdr! cell count)
(set! count (+ count 1)))) (set! count (+ count 1))))
(cont x cell))))) (cont x cell)))))
(cond (let wr ((x x))
((null? shared) (check-shared
(write x out)) x
(else ""
(let wr ((x x)) (lambda (x shared?)
(check-shared (cond
x ((pair? x)
"" (display "(" out)
(lambda (x shared?) (wr (car x))
(cond (let lp ((ls (cdr x)))
((pair? x) (check-shared
(display "(" out) ls
(wr (car x)) " . "
(let lp ((ls (cdr x))) (lambda (ls shared?)
(check-shared (cond ((null? ls))
ls ((pair? ls)
" . " (cond
(lambda (ls shared?) (shared?
(cond ((null? ls)) (display "(" out)
((pair? ls) (wr (car ls))
(cond (check-shared
(shared? (cdr ls)
(display "(" out) " . "
(wr (car ls)) (lambda (ls shared?) (lp ls)))
(check-shared (display ")" out))
(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 (car ls))
(display ")" out)) (lp (cdr ls)))))
((vector? x) (else
(display "#(" out) (display " . " out)
(let ((len (vector-length x))) (wr ls))))))
(cond ((> len 0) (display ")" out))
(wr (vector-ref x 0)) ((vector? x)
(do ((i 1 (+ i 1))) (display "#(" out)
((= i len)) (let ((len (vector-length x)))
(display " " out) (cond ((> len 0)
(wr (vector-ref x i)))))) (wr (vector-ref x 0))
(display ")" out)) (do ((i 1 (+ i 1)))
((let ((type (type-of x))) ((= i len))
(and (type? type) (type-printer type))) (display " " out)
=> (lambda (printer) (printer x wr out))) (wr (vector-ref x i))))))
(else (display ")" out))
(write x out)))))))))) ((let ((type (type-of x)))
(and (type? type) (type-printer type)))
=> (lambda (printer) (printer x wr out)))
(else
(write x out))))))))
(define write/ss write-with-shared-structure) (define write/ss write-with-shared-structure)