From d9e1f20286dda89de087fe79a47268d62b185790 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 1 Jun 2012 17:54:58 -0700
Subject: [PATCH] listener: move pprint error catching to stack.

---
 basis/listener/listener.factor       |  9 +--------
 basis/prettyprint/prettyprint.factor | 20 ++++++++++++++------
 2 files changed, 15 insertions(+), 14 deletions(-)

diff --git a/basis/listener/listener.factor b/basis/listener/listener.factor
index f105892ca6..59ddff1f75 100644
--- 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 249a6e0a57..162b480824 100644
--- 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. ;
-- 
2.34.1