suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

merged 308:311 from branches/sstrickl

Browse Source 
Now null values are printed out as "null" instead of
"#<struct:object:null%>".  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
This commit is contained in:
Stevie Strickland 2005-07-04 02:47:32 +00:00
parent b0e056190a
commit 50a7859893
2 changed files with 80 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
collects/honu/private/compiler/translate.ss
View File

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

39
collects/honu/tool.ss
View File

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