fixing the inspector

diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor
index 0f980d8c44e17df3bd18fde86516b4a75c235d5b..6976292a7cadb6004cade05a13f0484fb27ff443 100644 (file)
--- a/library/tools/inspector.factor
+++ b/library/tools/inspector.factor
@@ -31,7 +31,7 @@ M: hashtable sheet hash>alist unzip 2list ;
 
 : describe ( obj -- list )
     sheet dup first length count swons
-    dup third over first zip [ uncons set ] each
+    dup peek over first zip [ uncons set ] each
     [ column ] map
     seq-transpose
     [ " " join ] map ;
@@ -54,12 +54,50 @@ M: hashtable sheet hash>alist unzip 2list ;
 : a/an. ( noun -- )
     dup a/an write write ;
 
+: interned? ( word -- ? )
+    dup word-name swap word-vocabulary vocab hash ;
+
+: class-banner ( word -- )
+    dup metaclass dup [
+        "This is a class whose behavior is specifed by the " write
+        unparse write " metaclass," print
+        "currently having " write
+        "predicate" word-prop instances length unparse write
+        " instances." print
+    ] [
+        2drop
+    ] ifte ;
+
+: vocab-banner ( word -- )
+    dup word-vocabulary [
+        dup interned? [
+            "This word is located in the " write
+        ] [
+            "This is an orphan not part of the dictionary." print
+            "It claims to belong to the " write
+        ] ifte
+        word-vocabulary unparse write " vocabulary." print
+    ] [
+        drop
+        "The word is a uniquely generated symbol." print
+    ] ifte ;
+
+M: word extra-banner ( obj -- )
+    dup vocab-banner swap class-banner ;
+
+M: object extra-banner ( obj -- ) drop ;
+
 : inspect-banner ( obj -- )
-    "Inspecting " write dup class unparse a/an.
-    " with representation " write dup unparse write "," print
-    "located at address " write dup address >hex write
-    ", consuming " write size unparse write
-    " bytes of memory." print ;
+    dup references length >r
+    "You are looking at " write dup class unparse a/an.
+    " object with the following printed representation:" print
+    "  " write dup unparse print
+    "It is located at address " write dup address >hex write
+    " and takes up " write dup size unparse write
+    " bytes of memory." print
+    "This object is referenced from " write r> unparse write
+    " other objects in the heap." print
+    extra-banner ;
 
 : inspect ( obj -- )
     dup inspect-banner