exported pretty-format, a parameter maker for setting the pretty

format for various forms.  The pretty format structure is not
documented yet and there is no error-checking mechanism for
verifying proper input.
This commit is contained in:
Abdulaziz Ghuloum 2008-05-12 01:00:01 -04:00
parent f8b0e949d9
commit f05f171f28
5 changed files with 27 additions and 19 deletions

Binary file not shown.

View File

@ -15,10 +15,10 @@
(library (ikarus pretty-print) (library (ikarus pretty-print)
(export pretty-print pretty-width) (export pretty-print pretty-width pretty-format)
(import (import
(rnrs hashtables) (rnrs hashtables)
(except (ikarus) pretty-print pretty-width)) (except (ikarus) pretty-print pretty-width pretty-format))
(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
@ -609,6 +609,15 @@
(if (output-port? p) (if (output-port? p)
(pretty x p) (pretty x p)
(die 'pretty-print "not an output port" p))])) (die 'pretty-print "not an output port" p))]))
(define pretty-format
(lambda (x)
(unless (symbol? x)
(die 'pretty-format "not a symbol" x))
(case-lambda
[() (getprop x '*pretty-format*)]
[(v) (putprop x '*pretty-format* v)])))
;;; standard formats ;;; standard formats
(set-fmt! 'quote '(read-macro . "'")) (set-fmt! 'quote '(read-macro . "'"))
(set-fmt! 'unquote '(read-macro . ",")) (set-fmt! 'unquote '(read-macro . ","))

View File

@ -449,22 +449,20 @@
(define macro (define macro
(lambda (x h) (lambda (x h)
(define macro-forms (and
'([quote . "'"] (pair? x)
[quasiquote . "`"] (let ([a ($car x)])
[unquote . ","] (and
[unquote-splicing . ",@"] (symbol? a)
[syntax . "#'"] (let ([d ($cdr x)])
[quasisyntax . "#`"] (and (pair? d)
[unsyntax . "#,"] (null? ($cdr d))
[unsyntax-splicing . "#,@"] (not (hashtable-ref h x #f))))
[|#primitive| . "#%"])) (let ([p ((pretty-format a))])
(and (pair? x) (and (pair? p)
(let ([d ($cdr x)]) (eq? (car p) 'read-macro)
(and (pair? d) (string? (cdr p)))
(null? ($cdr d)) p))))))
(not (hashtable-ref h x #f))))
(assq ($car x) macro-forms))))
(define write-pair (define write-pair
(lambda (x p m h i) (lambda (x p m h i)

View File

@ -1 +1 @@
1471 1472

View File

@ -1285,6 +1285,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-format i]
[pretty-width i] [pretty-width i]
[module i cm] [module i cm]
[library i] [library i]