* pretty-width is now exported.

* generate-temporaries uses the names of identifiers to construct
  new names.
This commit is contained in:
Abdulaziz Ghuloum 2007-10-31 04:34:14 -04:00
parent 4823c9cb5a
commit b8434045f7
4 changed files with 21 additions and 4 deletions

Binary file not shown.

View File

@ -15,10 +15,10 @@
(library (ikarus pretty-print)
(export pretty-print)
(export pretty-print pretty-width)
(import
(rnrs hashtables)
(except (ikarus) pretty-print))
(except (ikarus) pretty-print pretty-width))
(define (map1ltr f ls)
;;; ltr so that gensym counts get assigned properly
(cond
@ -26,7 +26,14 @@
[else
(let ([a (f (car 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-struct cbox (length boxes))
(define-struct pbox (length ls last))

View File

@ -344,6 +344,7 @@
[read-token i]
[unread-char i]
[printf i]
[fprintf i]
[format i]
[comment-handler i]
[print-gensym i symbols]
@ -1257,6 +1258,7 @@
[set-symbol-value! i symbols $boot]
[eval-core $boot]
[pretty-print i $boot]
[pretty-width i]
[module i cm]
[syntax-dispatch ]
[syntax-error i sc]

View File

@ -3202,7 +3202,15 @@
(lambda (ls)
(syntax-match 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")))))