From 50a78598934a688ff03a30eba55465fe6259666b Mon Sep 17 00:00:00 2001 From: Stevie Strickland Date: Mon, 4 Jul 2005 02:47:32 +0000 Subject: [PATCH] merged 308:311 from branches/sstrickl Now null values are printed out as "null" instead of "#". Simple addition, but useful. This also adds a very unintelligent pretty printing for classes by adding a new public member for every Honu generated class that gets called by format-honu (in tool.ss). This pretty printing reveals the values for static members. Eventually I'll want to add an option to print just classes or classes + fields, like in ProfessorJ, but this was the heavy lifting of getting classes + fields printing out in the first place. svn: r312 --- collects/honu/private/compiler/translate.ss | 52 ++++++++++++++++++++- collects/honu/tool.ss | 39 ++++++++++++---- 2 files changed, 80 insertions(+), 11 deletions(-) diff --git a/collects/honu/private/compiler/translate.ss b/collects/honu/private/compiler/translate.ss index 0070de70dd..7eb6f30e53 100644 --- a/collects/honu/private/compiler/translate.ss +++ b/collects/honu/private/compiler/translate.ss @@ -71,6 +71,7 @@ ,@(map (lambda (m) (translate-member tenv #f m)) members) ,@(translate-class-exports tenv exports) + ,(translate-formatter tenv name members #f) (super-new))))] [else (raise-read-error-with-stx "Haven't translated that type of definition yet." @@ -92,6 +93,53 @@ ,(translate-super-new tenv arg-type super-new) ,@(map (lambda (m) (translate-member tenv arg-type m)) members-after) - ,@(translate-subclass-exports tenv base-types arg-type exports)))))])) + ,@(translate-subclass-exports tenv base-types arg-type exports) + ,(translate-formatter tenv name (append members-before members-after) arg-type)))))])) - ) + (define (translate-formatter tenv name members arg-type) + (let ([right-define (if arg-type 'define/override 'define/public)]) + `(,right-define (format-class renderer indent) + (format "~a {~a}" + (quote ,(syntax-e name)) + ,(cons 'string-append + (let ([printable-members (filter (lambda (m) + (not (honu:method? m))) + members)] + [printable-smembers (if arg-type + (filter-map (lambda (m) + (if (not (honu:type-disp? (tenv:member-type m))) + (tenv:member-name m) + #f)) + (tenv:type-members (get-type-entry tenv arg-type))) + '())] + ;; how much more do we want the members indented? Let's try 2 spaces more. + [indent-delta 2]) + (if (and (null? printable-members) + (null? printable-smembers)) + '("") + (fold-right (lambda (m l) + (list* "\n" (translate-super-member-formatter tenv arg-type m indent-delta) l)) + (fold-right (lambda (m l) + (list* "\n" (translate-member-formatter m indent-delta) l)) + '("\n" (make-string indent #\space)) + printable-members) + printable-smembers)))))))) + + (define (translate-member-formatter member indent-delta) + (let ([name (if (honu:field? member) + (honu:field-name member) + (honu:init-field-name member))]) + `(format "~a~a = ~a;" + (make-string (+ indent ,indent-delta) #\space) + (quote ,(syntax-e name)) + ;; the 3 is for " = " + (renderer ,name (+ indent ,(+ indent-delta (string-length (symbol->string (syntax-e name))) 3)))))) + + (define (translate-super-member-formatter tenv arg-type name indent-delta) + `(format "~a~a = ~a;" + (make-string (+ indent ,indent-delta) #\space) + (quote ,(syntax-e name)) + ;; as before, the 3 is for " = " + (renderer ,(translate-static-field-getter tenv arg-type name) + (+ indent ,(+ indent-delta (string-length (symbol->string (syntax-e name))) 3))))) + ) \ No newline at end of file diff --git a/collects/honu/tool.ss b/collects/honu/tool.ss index 5e565331e2..29c8a659b6 100644 --- a/collects/honu/tool.ss +++ b/collects/honu/tool.ss @@ -8,6 +8,7 @@ (lib "list.ss" "srfi" "1") "parsers/lex.ss" "parsers/parse.ss" + (only "base.ss" null%) "tenv.ss" "compile.ss" (lib "string-constant.ss" "string-constants")) @@ -88,7 +89,7 @@ (old-current-eval (syntax-as-top exp))))) (namespace-attach-module n path) (namespace-require path))))) - (define/public (render-value value settings port) (display (format-honu value settings #t) port)) + (define/public (render-value value settings port) (display (format-honu value settings 0) port)) (define/public (render-value/format value settings port width) (render-value value settings port) (if (not (null? value)) (newline port))) (define/public (unmarshall-settings x) x) (define/public (create-executable settings parent src-file teachpacks) @@ -108,7 +109,7 @@ (define (matches-language l) (and l (pair? l) (pair? (cdr l)) (equal? (cadr l) "Honu"))) - (define (format-honu value settings at-top?) + (define (format-honu value settings indent) (cond [(number? value) (format "~a" value)] [(char? value) (format "'~a'" value)] @@ -124,14 +125,34 @@ ;; the following makes it so that nothing is printed out ;; for a void value, but if a zero-tuple is part of a tuple ;; or structure, then it is printed out. - (if at-top? "" "()")] + (if (= indent 0) "" "()")] [(list? value) - (string-append "(" - (fold (lambda (v s) - (string-append s ", " (format-honu v settings #f))) - (format-honu (car value) settings #f) - (cdr value)) - ")")] + (if (any (lambda (v) + ;; checking to see if it's a non-null object + (and (object? v) (not (is-a? v null%)))) + value) + (string-append "(" + (fold (lambda (v s) + ;; if there are objects in the list, then we'll + ;; print each value on its own line. + (string-append s ",\n" (make-string (+ indent 1) #\space) + (format-honu v settings (+ indent 1)))) + (format-honu (car value) settings (+ indent 1)) + (cdr value)) + ")") + (string-append "(" + (fold (lambda (v s) + ;; if there are no objects, then we'll just print out + ;; the list on the same line. + (string-append s ", " (format-honu v settings (+ indent 1)))) + (format-honu (car value) settings (+ indent 1)) + (cdr value)) + ")"))] + [(is-a? value null%) "null"] + [(object? value) (send value format-class + (lambda (value at-top?) + (format-honu value settings at-top?)) + indent)] [else (format "~a" value)]))