listener: move pprint error catching to stack.

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index f105892ca65402ad3eb878dc864e010906a19daa..59ddff1f752e20c57c65a6180e3ec8fcc8d938be 100644 (file)
--- a/basis/listener/listener.factor
+++ b/basis/listener/listener.factor
@@ -93,13 +93,6 @@ t error-summary? set-global
         ] tabular-output nl
     ] unless-empty ;
 
-: print-stack ( seq -- )
-    [
-        [ short. ]
-        [ drop "~pprint error~" swap write-object nl ]
-        recover
-    ] each ;
-
 : trimmed-stack. ( seq -- )
     dup length max-stack-items get > [
         max-stack-items get cut*
@@ -107,7 +100,7 @@ t error-summary? set-global
             [ length number>string "(" " more items)" surround ] keep
             write-object nl
         ] dip
-    ] when print-stack ;
+    ] when stack. ;
 
 : datastack. ( datastack -- )
     display-stacks? get [

diff --git a/basis/prettyprint/prettyprint.factor b/basis/prettyprint/prettyprint.factor
index 249a6e0a57d67c026fb496a2455b5cc784205342..162b4808242b186fedb23664ee9d528990c5b3dd 100644 (file)
--- a/basis/prettyprint/prettyprint.factor
+++ b/basis/prettyprint/prettyprint.factor
@@ -1,10 +1,11 @@
 ! Copyright (C) 2003, 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays accessors assocs colors combinators grouping io
-io.streams.string io.styles kernel make math math.parser namespaces
-parser prettyprint.backend prettyprint.config prettyprint.custom
-prettyprint.sections quotations sequences sorting strings vocabs
-vocabs.prettyprint words sets generic ;
+USING: arrays accessors assocs classes colors combinators
+continuations grouping io io.streams.string io.styles kernel
+make math math.parser namespaces parser prettyprint.backend
+prettyprint.config prettyprint.custom prettyprint.sections
+quotations sequences sorting strings vocabs vocabs.prettyprint
+words sets generic ;
 FROM: namespaces => set ;
 IN: prettyprint
 
@@ -38,7 +39,14 @@ IN: prettyprint
 : .o ( n -- ) >oct print ;
 : .h ( n -- ) >hex print ;
 
-: stack. ( seq -- ) [ short. ] each ;
+: stack. ( seq -- )
+    [
+        [ short. ] [
+            drop
+            [ class-of name>> "~pprint error: " "~" surround ]
+            keep write-object nl
+        ] recover
+    ] each ;
 
 : .s ( -- ) datastack stack. ;
 : .r ( -- ) retainstack stack. ;