mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-31 09:20:23 +02:00
Code Activity

* format.scm (format:obj->str): Handle circular references. Also,

Browse source 
print improper lists with (x y . z) syntax rather than as
individual pairs.  (This code should probably be integrated into C
level facilities.  It is currently terribly slow.)
This commit is contained in:
Mikael Djurfeldt 2000-04-04 11:40:39 +00:00
parent f60d011a05
commit 186cf94654
1 changed files with 78 additions and 52 deletions
Download patch file Download diff file Expand all files Collapse all files

56
ice-9/format.scm
View file

@ -775,6 +775,10 @@
;; quoted strings so that the output can always be processed by (read)
(define (format:obj->str obj slashify)
(define (obj->str obj slashify visited)
(if (memq obj (cdr visited))
(let ((n (- (list-index (cdr visited) (cdr obj)))))
(string-append "#" (number->string n) "#"))
(cond
((string? obj)
(if slashify
@ -814,29 +818,51 @@
((output-port? obj)
(format:iobj->str obj))
((list? obj)
(string-append "("
(let loop ((obj-list obj))
(if (null? (cdr obj-list))
(format:obj->str (car obj-list) #t)
(string-append
(format:obj->str (car obj-list) #t)
" "
(loop (cdr obj-list)))))
")"))
((pair? obj)
(string-append "("
(format:obj->str (car obj) #t)
(let loop ((obj-list obj)
(visited visited)
(offset 0))
(cond ((null? (cdr obj-list))
(obj->str (car obj-list)
#t
(cons (car obj-list) visited)))
((memq (cdr obj-list) visited)
(string-append
(obj->str (car obj-list)
#t
(cons (car obj-list) visited))
" . #"
(number->string
(- offset
(list-index visited (cdr obj-list))))
"#"))
((pair? (cdr obj-list))
(string-append
(obj->str (car obj-list)
#t
(cons (car obj-list) visited))
" "
(loop (cdr obj-list)
(cons (cdr obj-list) visited)
(+ 1 offset))))
(else
(string-append
(obj->str (car obj-list)
#t
(cons (car obj-list) visited))
" . "
(format:obj->str (cdr obj) #t)
(obj->str (cdr obj-list)
#t
(cons (cdr obj-list) visited))))))
")"))
((vector? obj)
(string-append "#" (format:obj->str (vector->list obj) #t)))
(string-append "#" (obj->str (vector->list obj) #t visited)))
(else ; only objects with an #<...>
(format:iobj->str obj)))) ; representation should fall in here
(format:iobj->str obj))))) ; representation should fall in here
(obj->str obj slashify (list obj)))
;; format:iobj->str reveals the implementation dependent representation of
;; #<...> objects with the use of display and call-with-output-string.