Avoid unnecessary use of fprintf.

Closes #3113.
This commit is contained in:
Sam Tobin-Hochstadt 2020-04-21 13:27:19 -04:00 committed by Sam Tobin-Hochstadt
parent 392dc33ceb
commit 859e7b4373
3 changed files with 25 additions and 4 deletions

View File

@ -0,0 +1,20 @@
#lang racket/base
(require racket/contract)
;; This test checks that names of records using ~ can be dumped successfully
;; The contracted procedure is here because the rumble implementation has a
;; ~ in the name.
(define foo
(contract (-> #:x any/c any/c)
(λ (#:x x) 0)
'pos
'neg))
(struct ~s ( x))
(define v (~s 1))
(dump-memory-stats)
v

View File

@ -22,7 +22,7 @@
with-input-from-file with-output-to-file
call-with-output-file
file-position
write display newline port-name port-closed? write-char
write newline port-name port-closed? write-char
print-graph print-vector-length
date? make-date
dynamic-wind
@ -67,6 +67,7 @@
[fprintf chez:fprintf]
[printf chez:printf]
[format chez:format]
[display chez:display]
[current-error-port chez:current-error-port]
[string->number chez:string->number]
[number->string chez:number->string]

View File

@ -318,10 +318,10 @@
(unless skip-counts?
(#%fprintf (current-error-port) "Begin RacketCS\n")
(for-each (lambda (e)
(chez:fprintf (current-error-port)
(layout-line (chez:format "~a" (car e))
(chez:display (layout-line (chez:format "~a" (car e))
((get-count #f) e) ((get-bytes #f) e)
((get-count #t) e) ((get-bytes #t) e))))
((get-count #t) e) ((get-bytes #t) e))
(current-error-port)))
(list-sort (lambda (a b) (< ((get-bytes #f) a) ((get-bytes #f) b))) counts))
(#%fprintf (current-error-port) (layout-line "total"
(apply + (map (get-count #f) counts))