prettyprint: make callstack output needlessly fancier

basis/prettyprint/prettyprint.factor

@@ -74,29 +74,53 @@ SYMBOL: ->
 : remove-breakpoints ( quot pos -- quot' )
     1 + short cut [ (remove-breakpoints) ] bi@ [ -> ] glue ;
 
-: callframe. ( triple -- )
+: optimized-frame? ( triple -- ? ) second word? ;
-    first3
+
+: frame-word? ( triple -- ? )
+    first word? ;
+
+: frame-word. ( triple -- )
+    first {
+        { [ dup method? ] [ "Method: " write pprint ] }
+        { [ dup word? ] [ "Word: " write pprint ] }
+        [ drop ]
+    } cond ;
+
+: optimized-frame. ( triple -- )
     [
-        {
+        [ "(O)" write ] with-cell
-            { [ dup method? ] [ "Method: " write . ] }
+        [ frame-word. ] with-cell
-            { [ dup word? ] [ "Word: " write . ] }
+    ] with-row ;
-            [ drop ]
+
-        } cond
+: unoptimized-frame. ( triple -- )
-    ] 2dip
+    [
-    over quotation? [
+        [ "(U)" write ] with-cell
-        "Quotation: " write
-        remove-breakpoints
         [
-            3 nesting-limit set
+            "Quotation: " write
-            100 length-limit set
+            dup [ second ] [ third ] bi remove-breakpoints
-            .
+            [
-        ] with-scope
+                3 nesting-limit set
-    ] [ 2drop ] if ;
+                100 length-limit set
+                pprint
+            ] with-scope
+        ] with-cell
+    ] with-row
+    dup frame-word? [
+        [
+            [ ] with-cell
+            [ frame-word. ] with-cell
+        ] with-row
+    ] [ drop ] if ;
+
+: callframe. ( triple -- )
+    dup optimized-frame?
+    [ optimized-frame. ] [ unoptimized-frame. ] if ;
 
 PRIVATE>
 
 : callstack. ( callstack -- )
-    callstack>array 3 <groups> [ nl ] [ callframe. ] interleave ;
+    callstack>array 3 <groups>
+    { { table-gap { 5 5 } } } [ [ callframe. ] each ] tabular-output nl ;
 
 : .c ( -- ) callstack callstack. ;