1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
; Copyright (c) 1993-1999 by Richard Kelsey and Jonathan Rees. See file COPYING.
; ,open architecture primitives low-level locations debug-data syntactic
; July 5th
;total number of 3-vectors: 10896
;probably table entries: 10381
;symbol keys: 7363
;integer keys: 3018
;symbol values: 3793
;location values: 2062
;pair values: 1723
;operator values: 989
;debug-data values: 1208
;transform values: 510
; pair 4039 48468
; symbol 1067 8536
; vector 4477 124132
; closure 1541 18492
; location 807 9684
; port 2 40
; ratio 0 0
; record 579 16732
; continuation 6 136
; extended-number 0 0
; template 985 23916
; weak-pointer 33 264
; external 0 0
;unused-d-header1 0 0
;unused-d-header2 0 0
; string 1207 19338
; code-vector 986 51097
; double 0 0
; bignum 0 0
; total 15729 320835
(define (analyze-3-vectors)
(collect)
(let ((vs (find-all (enum stob vector)))
(total 0)
(table-entries 0)
(symbol-keys 0)
(int-keys 0)
(symbols 0)
(locations 0)
(debug-datas 0)
(pairs 0)
(operators 0))
(set! *foo* '())
(vector-for-each
(lambda (v)
(if (= (vector-length v) 3)
(let ((x (vector-ref v 2)))
(set! total (+ total 1))
(cond ((or (vector? x) (eq? x #f))
(set! table-entries (+ table-entries 1))
(let ((key (vector-ref v 0)))
(cond ((symbol? key)
(set! symbol-keys (+ symbol-keys 1)))
((integer? key)
(set! int-keys (+ int-keys 1)))))
(let ((val (vector-ref v 1)))
(cond ((symbol? val)
(set! symbols (+ symbols 1)))
((location? val)
(set! locations (+ locations 1)))
((pair? val)
(set! pairs (+ pairs 1)))
((transform? val)
(set! operators (+ operators 1)))
((debug-data? val)
(set! debug-datas (+ debug-datas 1)))
(else (set! *foo* (cons v *foo*))))))))))
vs)
(display "total number of 3-vectors: ") (write total) (newline)
(display "probably table entries: ") (write table-entries) (newline)
(display "symbol keys: ") (write symbol-keys) (newline)
(display "integer keys: ") (write int-keys) (newline)
(display "symbol values: ") (write symbols) (newline)
(display "location values: ") (write locations) (newline)
(display "pair values: ") (write pairs) (newline)
(display "transform values: ") (write operators) (newline)
(display "debug-data values: ") (write debug-datas) (newline)))
(define *foo* '())
(define (bar)
(collect)
(vector-size-histogram (find-all (enum stob vector))))
(define (vector-size-histogram vs)
(write (vector-length vs)) (display " vectors") (newline)
(let ((n 0))
(vector-for-each (lambda (v)
(if (eq? v vs) 'foo
(if (> (vector-length v) n)
(set! n (vector-length v)))))
vs)
(display "longest: ") (write n) (newline)
(let ((hist (make-vector (+ n 1) 0)))
(vector-for-each (lambda (v)
(let ((l (vector-length v)))
(vector-set! hist l (+ (vector-ref hist l) 1))))
vs)
(let loop ((i 0))
(if (< i n)
(let ((m (vector-ref hist i)))
(if (> m 0)
(begin (write-padded i 6)
(write-padded m 7)
(write-padded (* (+ (* i m) 1) 4) 7)
(newline)))
(loop (+ i 1))))))))
(define (write-padded x pad)
(let ((s (if (symbol? x)
(symbol->string x)
(number->string x))))
(do ((i (- pad (string-length s)) (- i 1)))
((<= i 0) (display s))
(write-char #\space))))
(define (vector-for-each proc v)
(let ((z (vector-length v)))
(do ((i (- z 1) (- i 1)))
((< i 0) #f)
(if (not (vector-unassigned? v i))
(proc (vector-ref v i))))))
|
