* 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) (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))

View File

@ -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]

View File

@ -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")))))