Better status report for time-it

This commit is contained in:
Abdulaziz Ghuloum 2007-08-30 17:25:29 -04:00
parent 2371c5a776
commit d2419aca42
4 changed files with 255 additions and 244 deletions

Binary file not shown.

View File

@ -24,6 +24,10 @@
v))))) v)))))
(define-syntax inthash (define-syntax inthash
(syntax-rules ()
[(_ x) x]))
#;(define-syntax inthash
(syntax-rules () (syntax-rules ()
[(_ x) ($fxinthash x)])) [(_ x) ($fxinthash x)]))

View File

@ -21,7 +21,7 @@
(define (print-stats message bytes t1 t0) (define (print-stats message bytes t1 t0)
(define (print-time msg msecs gc-msecs) (define (print-time msg msecs gc-msecs)
(printf " ~a ms elapsed ~a time (~a ms collecting)\n" msecs msg (printf " ~a ms elapsed ~a time, including ~a ms collecting\n" msecs msg
gc-msecs)) gc-msecs))
(define (msecs s1 s0 u1 u0) (define (msecs s1 s0 u1 u0)
(+ (* (- s1 s0) 1000) (quotient (- u1 u0) 1000))) (+ (* (- s1 s0) 1000) (quotient (- u1 u0) 1000)))

View File

@ -31,6 +31,8 @@
[rp (rnrs records procedural (6))] [rp (rnrs records procedural (6))]
[rs (rnrs records syntactic (6))] [rs (rnrs records syntactic (6))]
[r5 (rnrs r5rs (6))] [r5 (rnrs r5rs (6))]
[se (scheme-report-environment)]
[ne (null-environment)]
)) ))
(define status-names (define status-names
@ -42,199 +44,199 @@
(define identifier-names (define identifier-names
'( '(
;;;
[lambda C ba] [lambda C ba se ne]
[and C ba] [and C ba se ne]
[begin C ba] [begin C ba se ne]
[case C ba] [case C ba se ne]
[cond C ba] [cond C ba se ne]
[define C ba] [define C ba se ne]
[define-syntax C ba] [define-syntax C ba se ne]
[identifier-syntax C ba] [identifier-syntax C ba]
[if C ba] [if C ba se ne]
[let C ba] [let C ba se ne]
[let* C ba] [let* C ba se ne]
[let*-values C ba] [let*-values C ba]
[let-syntax C ba] [let-syntax C ba se ne]
[let-values C ba] [let-values C ba]
[letrec C ba] [letrec C ba se ne]
[letrec* C ba] [letrec* C ba]
[letrec-syntax C ba] [letrec-syntax C ba se ne]
[or C ba] [or C ba se ne]
[quasiquote C ba] [quasiquote C ba se ne]
[quote C ba] [quote C ba se ne]
[set! C ba] [set! C ba se ne]
[syntax-rules C ba] [syntax-rules C ba se ne]
[unquote C ba] [unquote C ba se ne]
[unquote-splicing C ba] [unquote-splicing C ba se ne]
[< C ba] [< C ba se]
[<= C ba] [<= C ba se]
[= C ba] [= C ba se]
[> C ba] [> C ba se]
[>= C ba] [>= C ba se]
[+ C ba] [+ C ba se]
[- C ba] [- C ba se]
[* C ba] [* C ba se]
[/ C ba] [/ C ba se]
[abs C ba] [abs C ba se]
[acos S ba] [acos S ba se]
[angle D ba] [angle D ba se]
[append C ba] [append C ba se]
[apply C ba] [apply C ba se]
[asin S ba] [asin S ba se]
[assert S ba] [assert S ba]
[assertion-violation S ba] [assertion-violation S ba]
[atan S ba] [atan S ba se]
[boolean=? C ba] [boolean=? C ba]
[boolean? C ba] [boolean? C ba se]
[car C ba] [car C ba se]
[cdr C ba] [cdr C ba se]
[caar C ba] [caar C ba se]
[cadr C ba] [cadr C ba se]
[cdar C ba] [cdar C ba se]
[cddr C ba] [cddr C ba se]
[caaar C ba] [caaar C ba se]
[caadr C ba] [caadr C ba se]
[cadar C ba] [cadar C ba se]
[caddr C ba] [caddr C ba se]
[cdaar C ba] [cdaar C ba se]
[cdadr C ba] [cdadr C ba se]
[cddar C ba] [cddar C ba se]
[cdddr C ba] [cdddr C ba se]
[caaaar C ba] [caaaar C ba se]
[caaadr C ba] [caaadr C ba se]
[caadar C ba] [caadar C ba se]
[caaddr C ba] [caaddr C ba se]
[cadaar C ba] [cadaar C ba se]
[cadadr C ba] [cadadr C ba se]
[caddar C ba] [caddar C ba se]
[cadddr C ba] [cadddr C ba se]
[cdaaar C ba] [cdaaar C ba se]
[cdaadr C ba] [cdaadr C ba se]
[cdadar C ba] [cdadar C ba se]
[cdaddr C ba] [cdaddr C ba se]
[cddaar C ba] [cddaar C ba se]
[cddadr C ba] [cddadr C ba se]
[cdddar C ba] [cdddar C ba se]
[cddddr C ba] [cddddr C ba se]
[call-with-current-continuation C ba] [call-with-current-continuation C ba se]
[call/cc C ba] [call/cc C ba]
[call-with-values C ba] [call-with-values C ba se]
[ceiling C ba] [ceiling C ba se]
[char->integer C ba] [char->integer C ba se]
[char<=? C ba] [char<=? C ba se]
[char<? C ba] [char<? C ba se]
[char=? C ba] [char=? C ba se]
[char>=? C ba] [char>=? C ba se]
[char>? C ba] [char>? C ba se]
[char? C ba] [char? C ba se]
[complex? D ba] [complex? D ba se]
[cons C ba] [cons C ba se]
[cos C ba] [cos C ba se]
[denominator C ba] [denominator C ba se]
[div S ba] [div S ba]
[div-and-mod S ba] [div-and-mod S ba]
[div0 S ba] [div0 S ba]
[div0-and-mod0 S ba] [div0-and-mod0 S ba]
[dynamic-wind C ba] [dynamic-wind C ba se]
[eq? C ba] [eq? C ba se]
[equal? S ba] [equal? S ba se]
[eqv? C ba] [eqv? C ba se]
[error S ba] [error S ba]
[even? C ba] [even? C ba se]
[exact C ba] [exact C ba]
[exact-integer-sqrt C ba] [exact-integer-sqrt C ba]
[exact? C ba] [exact? C ba se]
[exp S ba] [exp S ba se]
[expt C ba] [expt C ba se]
[finite? S ba] [finite? S ba]
[floor C ba] [floor C ba se]
[for-each S ba] [for-each S ba se]
[gcd C ba] [gcd C ba se]
[imag-part D ba] [imag-part D ba se]
[inexact C ba] [inexact C ba]
[inexact? S ba] [inexact? S ba se]
[infinite? S ba] [infinite? S ba]
[integer->char C ba] [integer->char C ba se]
[integer-valued? S ba] [integer-valued? S ba]
[integer? C ba] [integer? C ba se]
[lcm C ba] [lcm C ba se]
[length C ba] [length C ba se]
[list C ba] [list C ba se]
[list->string C ba] [list->string C ba se]
[list->vector C ba] [list->vector C ba se]
[list-ref C ba] [list-ref C ba se]
[list-tail C ba] [list-tail C ba se]
[list? C ba] [list? C ba se]
[log C ba] [log C ba se]
[magnitude D ba] [magnitude D ba se]
[make-polar D ba] [make-polar D ba se]
[make-rectangular D ba] [make-rectangular D ba se]
[make-string C ba] [make-string C ba se]
[make-vector C ba] [make-vector C ba se]
[map C ba] [map C ba se]
[max C ba] [max C ba se]
[min C ba] [min C ba se]
[mod S ba] [mod S ba]
[mod0 S ba] [mod0 S ba]
[nan? S ba] [nan? S ba]
[negative? C ba] [negative? C ba se]
[not C ba] [not C ba se]
[null? C ba] [null? C ba]
[number->string C ba] [number->string C ba se]
[number? C ba] [number? C ba se]
[numerator C ba] [numerator C ba se]
[odd? C ba] [odd? C ba se]
[pair? C ba] [pair? C ba se]
[positive? C ba] [positive? C ba se]
[procedure? C ba] [procedure? C ba se]
[rational-valued? S ba] [rational-valued? S ba]
[rational? C ba] [rational? C ba se]
[rationalize S ba] [rationalize S ba se]
[real-part D ba] [real-part D ba se]
[real-valued? S ba] [real-valued? S ba]
[real? S ba] [real? S ba se]
[reverse C ba] [reverse C ba se]
[round C ba] [round C ba se]
[sin C ba] [sin C ba se]
[sqrt C ba] [sqrt C ba se]
[string C ba] [string C ba se]
[string->list C ba] [string->list C ba se]
[string->number C ba] [string->number C ba se]
[string->symbol C ba] [string->symbol C ba se]
[string-append C ba] [string-append C ba se]
[string-copy C ba] [string-copy C ba se]
[string-for-each C ba] [string-for-each C ba]
[string-length C ba] [string-length C ba se]
[string-ref C ba] [string-ref C ba se]
[string<=? C ba] [string<=? C ba se]
[string<? C ba] [string<? C ba se]
[string=? C ba] [string=? C ba se]
[string>=? C ba] [string>=? C ba se]
[string>? C ba] [string>? C ba se]
[string? C ba] [string? C ba se]
[substring C ba] [substring C ba se]
[symbol->string C ba] [symbol->string C ba se]
[symbol=? C ba] [symbol=? C ba]
[symbol? C ba] [symbol? C ba se]
[tan S ba] [tan S ba se]
[truncate S ba] [truncate S ba se]
[values C ba] [values C ba se]
[vector C ba] [vector C ba se]
[vector->list C ba] [vector->list C ba se]
[vector-fill! S ba] [vector-fill! S ba se]
[vector-for-each C ba] [vector-for-each C ba]
[vector-length C ba] [vector-length C ba se]
[vector-map C ba] [vector-map C ba]
[vector-ref C ba] [vector-ref C ba se]
[vector-set! C ba] [vector-set! C ba se]
[vector? C ba] [vector? C ba se]
[zero? C ba] [zero? C ba se]
[... C ba sc] [... C ba sc]
[=> C ba ex] [=> C ba ex]
[_ C ba sc] [_ C ba sc]
[else C ba ex] [else C ba ex]
;;;
[bitwise-and D bw] [bitwise-and D bw]
[bitwise-arithmetic-shift D bw] [bitwise-arithmetic-shift D bw]
[bitwise-arithmetic-shift-left D bw] [bitwise-arithmetic-shift-left D bw]
@ -252,7 +254,7 @@
[bitwise-reverse-bit-field D bw] [bitwise-reverse-bit-field D bw]
[bitwise-rotate-bit-field D bw] [bitwise-rotate-bit-field D bw]
[bitwise-xor D bw] [bitwise-xor D bw]
;;;
[fixnum? C fx] [fixnum? C fx]
[fx* D fx] [fx* D fx]
[fx*/carry D fx] [fx*/carry D fx]
@ -295,7 +297,7 @@
[fxrotate-bit-field D fx] [fxrotate-bit-field D fx]
[fxxor D fx] [fxxor D fx]
[fxzero? D fx] [fxzero? D fx]
;;;
[fixnum->flonum S fl] [fixnum->flonum S fl]
[fl* C fl] [fl* C fl]
[fl+ C fl] [fl+ C fl]
@ -348,7 +350,7 @@
[no-infinities-violation? D fl] [no-infinities-violation? D fl]
[&no-nans D fl] [&no-nans D fl]
[no-nans-violation? D fl] [no-nans-violation? D fl]
;;;
[bytevector->sint-list C bv] [bytevector->sint-list C bv]
[bytevector->u8-list C bv] [bytevector->u8-list C bv]
[bytevector->uint-list C bv] [bytevector->uint-list C bv]
@ -407,7 +409,7 @@
[utf8->string S bv] [utf8->string S bv]
[utf16->string S bv] [utf16->string S bv]
[utf32->string S bv] [utf32->string S bv]
;;;
[condition? D co] [condition? D co]
[&assertion D co] [&assertion D co]
[assertion-violation? D co] [assertion-violation? D co]
@ -460,12 +462,12 @@
[warning? D co] [warning? D co]
[&who D co] [&who D co]
[who-condition? D co] [who-condition? D co]
;;;
[case-lambda C ct] [case-lambda C ct]
[do C ct] [do C ct se ne]
[unless C ct] [unless C ct]
[when C ct] [when C ct]
;;;
[define-enumeration D en] [define-enumeration D en]
[enum-set->list D en] [enum-set->list D en]
[enum-set-complement D en] [enum-set-complement D en]
@ -480,15 +482,15 @@
[enum-set-universe D en] [enum-set-universe D en]
[enum-set=? D en] [enum-set=? D en]
[make-enumeration D en] [make-enumeration D en]
;;;
[environment C ev] [environment C ev]
[eval C ev] [eval C ev se]
;;;
[raise S ex] [raise S ex]
[raise-continuable S ex] [raise-continuable S ex]
[with-exception-handler S ex] [with-exception-handler S ex]
[guard S ex] [guard S ex]
;;;
[binary-port? D ip] [binary-port? D ip]
[buffer-mode D ip] [buffer-mode D ip]
[buffer-mode? D ip] [buffer-mode? D ip]
@ -496,11 +498,11 @@
[call-with-bytevector-output-port D ip] [call-with-bytevector-output-port D ip]
[call-with-port D ip] [call-with-port D ip]
[call-with-string-output-port D ip] [call-with-string-output-port D ip]
;;;
[assoc C ls] [assoc C ls se]
[assp S ls] [assp S ls]
[assq C ls] [assq C ls se]
[assv C ls] [assv C ls se]
[cons* S ls] [cons* S ls]
[filter S ls] [filter S ls]
[find S ls] [find S ls]
@ -508,35 +510,35 @@
[fold-right S ls] [fold-right S ls]
[for-all S ls] [for-all S ls]
[exists S ls] [exists S ls]
[member C ls] [member C ls se]
[memp S ls] [memp S ls]
[memq C ls] [memq C ls se]
[memv C ls] [memv C ls se]
[partition S ls] [partition S ls]
[remove C ls] [remove C ls]
[remp S ls] [remp S ls]
[remq C ls] [remq C ls]
[remv C ls] [remv C ls]
;;;
[set-car! C mp] [set-car! C mp se]
[set-cdr! C mp] [set-cdr! C mp se]
;;;
[string-set! C ms] [string-set! C ms se]
[string-fill! S ms] [string-fill! S ms se]
;;;
[command-line C pr] [command-line C pr]
[exit C pr] [exit C pr]
;;;
[delay S r5] [delay S r5 se ne]
[exact->inexact C r5] [exact->inexact C r5 se]
[force S r5] [force S r5 se]
[inexact->exact C r5] [inexact->exact C r5 se]
[modulo C r5] [modulo C r5 se]
[remainder C r5] [remainder C r5 se]
[null-environment S r5] [null-environment S r5 se]
[quotient C r5] [quotient C r5 se]
[scheme-report-environment S r5] [scheme-report-environment S r5 se]
;;;
[close-port D ip] [close-port D ip]
[eol-style D ip] [eol-style D ip]
[error-handling-mode D ip] [error-handling-mode D ip]
@ -636,30 +638,30 @@
[transcoder-error-handling-mode D ip] [transcoder-error-handling-mode D ip]
[utf-16-codec D ip] [utf-16-codec D ip]
[utf-8-codec D ip] [utf-8-codec D ip]
;;;
[input-port? C is ip] [input-port? C is ip se]
[output-port? C is ip] [output-port? C is ip se]
[current-input-port C ip is] [current-input-port C ip is se]
[current-output-port C ip is] [current-output-port C ip is se]
[current-error-port C ip is] [current-error-port C ip is]
[eof-object C ip is] [eof-object C ip is se]
[eof-object? C ip is] [eof-object? C ip is]
[close-input-port C is] [close-input-port C is se]
[close-output-port C is] [close-output-port C is se]
[display C is] [display C is se]
[newline C is] [newline C is se]
[open-input-file C is] [open-input-file C is se]
[open-output-file C is] [open-output-file C is se]
[peek-char C is] [peek-char C is se]
[read C is] [read C is se]
[read-char C is] [read-char C is se]
[with-input-from-file C is] [with-input-from-file C is se]
[with-output-to-file C is] [with-output-to-file C is se]
[write C is] [write C is se]
[write-char C is] [write-char C is se]
[call-with-input-file C is] [call-with-input-file C is se]
[call-with-output-file C is] [call-with-output-file C is se]
;;;
[hashtable-clear! S ht] [hashtable-clear! S ht]
[hashtable-contains? S ht] [hashtable-contains? S ht]
[hashtable-copy S ht] [hashtable-copy S ht]
@ -681,14 +683,14 @@
[string-hash D ht] [string-hash D ht]
[string-ci-hash D ht] [string-ci-hash D ht]
[symbol-hash D ht] [symbol-hash D ht]
;;;
[list-sort S sr] [list-sort S sr]
[vector-sort S sr] [vector-sort S sr]
[vector-sort! S sr] [vector-sort! S sr]
;;;
[file-exists? C fi] [file-exists? C fi]
[delete-file C fi] [delete-file C fi]
;;;
[define-record-type D rs] [define-record-type D rs]
[fields D rs] [fields D rs]
[immutable D rs] [immutable D rs]
@ -701,7 +703,7 @@
[record-type-descriptor D rs] [record-type-descriptor D rs]
[sealed D rs] [sealed D rs]
[nongenerative D rs] [nongenerative D rs]
;;;
[record-field-mutable? D ri] [record-field-mutable? D ri]
[record-rtd D ri] [record-rtd D ri]
[record-type-field-names D ri] [record-type-field-names D ri]
@ -712,7 +714,7 @@
[record-type-sealed? D ri] [record-type-sealed? D ri]
[record-type-uid D ri] [record-type-uid D ri]
[record? D ri] [record? D ri]
;;;
[make-record-constructor-descriptor D rp] [make-record-constructor-descriptor D rp]
[make-record-type-descriptor D rp] [make-record-type-descriptor D rp]
[record-accessor D rp] [record-accessor D rp]
@ -720,7 +722,7 @@
[record-mutator D rp] [record-mutator D rp]
[record-predicate D rp] [record-predicate D rp]
[record-type-descriptor? D rp] [record-type-descriptor? D rp]
;;;
[bound-identifier=? C sc] [bound-identifier=? C sc]
[datum->syntax C sc] [datum->syntax C sc]
[syntax C sc] [syntax C sc]
@ -734,28 +736,28 @@
[generate-temporaries C sc] [generate-temporaries C sc]
[identifier? C sc] [identifier? C sc]
[make-variable-transformer S sc] [make-variable-transformer S sc]
;;;
[char-alphabetic? S uc] [char-alphabetic? S uc se]
[char-ci<=? C uc] [char-ci<=? C uc se]
[char-ci<? C uc] [char-ci<? C uc se]
[char-ci=? C uc] [char-ci=? C uc se]
[char-ci>=? C uc] [char-ci>=? C uc se]
[char-ci>? C uc] [char-ci>? C uc se]
[char-downcase C uc] [char-downcase C uc se]
[char-foldcase C uc] [char-foldcase C uc]
[char-titlecase C uc] [char-titlecase C uc]
[char-upcase C uc] [char-upcase C uc se]
[char-general-category S uc] [char-general-category S uc]
[char-lower-case? S uc] [char-lower-case? S uc se]
[char-numeric? S uc] [char-numeric? S uc se]
[char-title-case? S uc] [char-title-case? S uc]
[char-upper-case? S uc] [char-upper-case? S uc se]
[char-whitespace? C uc] [char-whitespace? C uc se]
[string-ci<=? S uc] [string-ci<=? S uc se]
[string-ci<? S uc] [string-ci<? S uc se]
[string-ci=? S uc] [string-ci=? S uc se]
[string-ci>=? S uc] [string-ci>=? S uc se]
[string-ci>? S uc] [string-ci>? S uc se]
[string-downcase S uc] [string-downcase S uc]
[string-foldcase S uc] [string-foldcase S uc]
[string-normalize-nfc S uc] [string-normalize-nfc S uc]
@ -764,6 +766,11 @@
[string-normalize-nfkd S uc] [string-normalize-nfkd S uc]
[string-titlecase S uc] [string-titlecase S uc]
[string-upcase S uc] [string-upcase S uc]
;;;
[char-ready? D ]
[interaction-environment D ]
[load D ]
;;;
)) ))
@ -774,7 +781,7 @@
(no-dups (cdr ls)))) (no-dups (cdr ls))))
(define (assert-id x) (define (assert-id x)
(unless (and (>= (length x) 3) (unless (and (>= (length x) 2)
(let ([name (car x)] (let ([name (car x)]
[status (cadr x)] [status (cadr x)]
[libs (cddr x)]) [libs (cddr x)])