remove math.blas.syntax and merge parsing words into math.blas.vectors/matrices
[factor/jcg.git] / basis / tools / memory / memory.factor
blob2ad16a4d8d6d34cff4886ff4e64c133b4a81e638
1 ! Copyright (C) 2005, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel sequences vectors arrays generic assocs io math
4 namespaces parser prettyprint strings io.styles vectors words
5 system sorting splitting grouping math.parser classes memory
6 combinators fry ;
7 IN: tools.memory
9 <PRIVATE
11 : write-size ( n -- )
12     number>string
13     dup length 4 > [ 3 cut* "," glue ] when
14     " KB" append write-cell ;
16 : write-total/used/free ( free total str -- )
17     [
18         write-cell
19         dup write-size
20         over - write-size
21         write-size
22     ] with-row ;
24 : write-total ( n str -- )
25     [
26         write-cell
27         write-size
28         [ ] with-cell
29         [ ] with-cell
30     ] with-row ;
32 : write-headings ( seq -- )
33     [ [ write-cell ] each ] with-row ;
35 : (data-room.) ( -- )
36     data-room 2 <groups> [
37         [ first2 ] [ number>string "Generation " prepend ] bi*
38         write-total/used/free
39     ] each-index
40     "Decks" write-total
41     "Cards" write-total ;
43 : write-labelled-size ( n string -- )
44     [ write-cell write-size ] with-row ;
46 : (code-room.) ( -- )
47     code-room {
48         [ "Size:" write-labelled-size ]
49         [ "Used:" write-labelled-size ]
50         [ "Total free space:" write-labelled-size ]
51         [ "Largest free block:" write-labelled-size ]
52     } spread ;
54 : heap-stat-step ( obj counts sizes -- )
55     [ over ] dip
56     [ [ class ] dip inc-at ]
57     [ [ [ size ] [ class ] bi ] dip at+ ] 2bi* ;
59 PRIVATE>
61 : room. ( -- )
62     "==== DATA HEAP" print
63     standard-table-style [
64         { "" "Total" "Used" "Free" } write-headings
65         (data-room.)
66     ] tabular-output
67     nl
68     "==== CODE HEAP" print
69     standard-table-style [
70         (code-room.)
71     ] tabular-output ;
73 : heap-stats ( -- counts sizes )
74     H{ } clone H{ } clone
75     2dup '[ _ _ heap-stat-step ] each-object ;
77 : heap-stats. ( -- )
78     heap-stats dup keys natural-sort standard-table-style [
79         { "Class" "Bytes" "Instances" } write-headings
80         [
81             [
82                 dup pprint-cell
83                 dup pick at pprint-cell
84                 pick at pprint-cell
85             ] with-row
86         ] each 2drop
87     ] tabular-output ;