* 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
	
	 Abdulaziz Ghuloum
						Abdulaziz Ghuloum