* pretty-width is now exported.
* generate-temporaries uses the names of identifiers to construct new names.
This commit is contained in:
parent
4823c9cb5a
commit
b8434045f7
Binary file not shown.
|
@ -15,10 +15,10 @@
|
||||||
|
|
||||||
|
|
||||||
(library (ikarus pretty-print)
|
(library (ikarus pretty-print)
|
||||||
(export pretty-print)
|
(export pretty-print pretty-width)
|
||||||
(import
|
(import
|
||||||
(rnrs hashtables)
|
(rnrs hashtables)
|
||||||
(except (ikarus) pretty-print))
|
(except (ikarus) pretty-print pretty-width))
|
||||||
(define (map1ltr f ls)
|
(define (map1ltr f ls)
|
||||||
;;; ltr so that gensym counts get assigned properly
|
;;; ltr so that gensym counts get assigned properly
|
||||||
(cond
|
(cond
|
||||||
|
@ -26,7 +26,14 @@
|
||||||
[else
|
[else
|
||||||
(let ([a (f (car ls))])
|
(let ([a (f (car ls))])
|
||||||
(cons a (map1ltr f (cdr ls))))]))
|
(cons a (map1ltr f (cdr ls))))]))
|
||||||
(define (pretty-width) 80)
|
|
||||||
|
(define pretty-width
|
||||||
|
(make-parameter 60
|
||||||
|
(lambda (x)
|
||||||
|
(unless (and (exact? x) (integer? x) (> x 0))
|
||||||
|
(error 'pretty-width "invalid argument" x))
|
||||||
|
x)))
|
||||||
|
|
||||||
(define (pretty-indent) 1)
|
(define (pretty-indent) 1)
|
||||||
(define-struct cbox (length boxes))
|
(define-struct cbox (length boxes))
|
||||||
(define-struct pbox (length ls last))
|
(define-struct pbox (length ls last))
|
||||||
|
|
|
@ -344,6 +344,7 @@
|
||||||
[read-token i]
|
[read-token i]
|
||||||
[unread-char i]
|
[unread-char i]
|
||||||
[printf i]
|
[printf i]
|
||||||
|
[fprintf i]
|
||||||
[format i]
|
[format i]
|
||||||
[comment-handler i]
|
[comment-handler i]
|
||||||
[print-gensym i symbols]
|
[print-gensym i symbols]
|
||||||
|
@ -1257,6 +1258,7 @@
|
||||||
[set-symbol-value! i symbols $boot]
|
[set-symbol-value! i symbols $boot]
|
||||||
[eval-core $boot]
|
[eval-core $boot]
|
||||||
[pretty-print i $boot]
|
[pretty-print i $boot]
|
||||||
|
[pretty-width i]
|
||||||
[module i cm]
|
[module i cm]
|
||||||
[syntax-dispatch ]
|
[syntax-dispatch ]
|
||||||
[syntax-error i sc]
|
[syntax-error i sc]
|
||||||
|
|
|
@ -3202,7 +3202,15 @@
|
||||||
(lambda (ls)
|
(lambda (ls)
|
||||||
(syntax-match ls ()
|
(syntax-match ls ()
|
||||||
((ls ...)
|
((ls ...)
|
||||||
(map (lambda (x) (make-stx (gensym 't) top-mark* '())) ls))
|
(map (lambda (x)
|
||||||
|
(make-stx
|
||||||
|
(let ([x (syntax->datum x)])
|
||||||
|
(cond
|
||||||
|
[(or (symbol? x) (string? x))
|
||||||
|
(gensym x)]
|
||||||
|
[else (gensym 't)]))
|
||||||
|
top-mark* '()))
|
||||||
|
ls))
|
||||||
(_
|
(_
|
||||||
(error 'generate-temporaries "not a list")))))
|
(error 'generate-temporaries "not a list")))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue