mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-02 13:00:26 +02:00
Code Activity

* boot-9.scm: Formatting tweaks.

Browse source
This commit is contained in:
Jim Blandy 1996-10-21 23:53:01 +00:00
parent 4b89050f0b
commit c7c03b9f87
1 changed files with 24 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

36
ice-9/boot-9.scm
View file

@ -296,19 +296,24 @@
(apply-to-args (append args (list-cdr-ref default-args (length args)))
(lambda (port depth length style table)
(cond
((and table (print-table-ref table obj)) ((print-style-tag-hook style 'eq-val)
obj port depth length style table))
((and table (print-table-ref table obj))
((print-style-tag-hook style 'eq-val)
obj port depth length style table))
(else
(and table (print-table-add! table obj))
(cond
((print-style-max-depth? style depth) ((print-style-excess-depth-hook style)))
((print-style-max-length? style length) ((print-style-excess-length-hook style)))
(else ((print-style-hook style obj)
obj port depth length style table)))))))))
((print-style-max-depth? style depth)
((print-style-excess-depth-hook style)))
((print-style-max-length? style length)
((print-style-excess-length-hook style)))
(else
((print-style-hook style obj)
obj port depth length style table)))))))))
(define (make-print-style) (make-vector 59 '()))
(define (extend-print-style! style utag printer) (hashq-set! style utag printer))
(define (extend-print-style! style utag printer)
(hashq-set! style utag printer))
(define (print-style-hook style obj)
(let ((type-tag (tag obj)))
@ -322,8 +327,10 @@
(define (print-style-max-depth? style d) #f)
(define (print-style-max-length? style l) #f)
(define (print-style-excess-length-hook style) (hashq-ref style 'excess-length-hook))
(define (print-style-excess-depth-hook style) (hashq-ref style 'excess-depth-hook))
(define (print-style-excess-length-hook style)
(hashq-ref style 'excess-length-hook))
(define (print-style-excess-depth-hook style)
(hashq-ref style 'excess-depth-hook))
(define (make-print-table) (make-vector 59 '()))
(define (print-table-ref table obj) (hashq-ref table obj))
@ -348,7 +355,8 @@
((null? (cdr pair)) (display #\) port))
(else (display " . " port)
(print (cdr pair) port (+ 1 depth) 0 style table)
(print (cdr pair) port (+ 1 depth) 0
style table)
(display #\) port))))
(define (print-vector obj port depth length style table)
@ -365,7 +373,9 @@
(cond
((>= (+ 1 length) (vector-length obj)) (display #\) port))
(else (display #\space port)
(print obj port depth (+ 1 length) style table))))
(print obj port depth
(+ 1 length)
style table))))
(define default-print-style (make-print-style))
@ -392,7 +402,9 @@
(define (make-record-type type-name fields . opt)
(let ((printer-fn (and (pair? opt) (car opt))))
(let ((struct (make-struct record-type-vtable 0
(make-struct-layout (apply symbol-append (map (lambda (f) "pw") fields)))
(make-struct-layout
(apply symbol-append
(map (lambda (f) "pw") fields)))
type-name
(copy-tree fields))))
;; !!! leaks printer functions