Improve memory tooL

extra/tools/memory/memory-tests.factor

@@ -1,4 +1,8 @@
 USING: tools.test tools.memory ;
 IN: tools.memory.tests
 
+\ room. must-infer
+[ ] [ room. ] unit-test
+
+\ heap-stats. must-infer
 [ ] [ heap-stats. ] unit-test

extra/tools/memory/memory.factor

@@ -1,22 +1,29 @@
-! Copyright (C) 2005, 2007 Slava Pestov.
+! Copyright (C) 2005, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel sequences vectors arrays generic assocs io math
 namespaces parser prettyprint strings io.styles vectors words
-system sorting splitting math.parser classes memory ;
+system sorting splitting math.parser classes memory combinators ;
 IN: tools.memory
 
+<PRIVATE
+
+: write-size ( n -- )
+    number>string
+    dup length 4 > [ 3 cut* "," swap 3append ] when
+    " KB" append write-cell ;
+
 : write-total/used/free ( free total str -- )
     [
         write-cell
-        dup number>string write-cell
+        dup write-size
-        over - number>string write-cell
+        over - write-size
-        number>string write-cell
+        write-size
     ] with-row ;
 
 : write-total ( n str -- )
     [
         write-cell
-        number>string write-cell
+        write-size
         [ ] with-cell
         [ ] with-cell
     ] with-row ;
@@ -25,26 +32,41 @@ IN: tools.memory
     [ [ write-cell ] each ] with-row ;
 
 : (data-room.) ( -- )
-    data-room 2 <groups> 0 [
+    data-room 2 <groups> dup length [
-        "Generation " pick number>string append
+        [ first2 ] [ number>string "Generation " prepend ] bi*
-        >r first2 r> write-total/used/free 1+
+        write-total/used/free
-    ] reduce drop
+    ] 2each
     "Cards" write-total ;
 
-: (code-room.) ( -- )
+: write-labelled-size ( n string -- )
-    code-room "Code space" write-total/used/free ;
+    [ write-cell write-size ] with-row ;
 
-: room. ( -- )
+: (code-room.) ( -- )
-    standard-table-style [
+    code-room {
-        { "" "Total" "Used" "Free" } write-headings
+        [ "Size:" write-labelled-size ]
-        (data-room.)
+        [ "Used:" write-labelled-size ]
-        (code-room.)
+        [ "Total free space:" write-labelled-size ]
-    ] tabular-output ;
+        [ "Largest free block:" write-labelled-size ]
+    } spread ;
 
 : heap-stat-step ( counts sizes obj -- )
     [ dup size swap class rot at+ ] keep
     1 swap class rot at+ ;
 
+PRIVATE>
+
+: room. ( -- )
+    "==== DATA HEAP" print
+    standard-table-style [
+        { "" "Total" "Used" "Free" } write-headings
+        (data-room.)
+    ] tabular-output
+    nl
+    "==== CODE HEAP" print
+    standard-table-style [
+        (code-room.)
+    ] tabular-output ;
+
 : heap-stats ( -- counts sizes )
     H{ } clone H{ } clone
     [ >r 2dup r> heap-stat-step ] each-object ;