listener: move pprint error catching to stack.

db4
John Benediktsson 2012-06-01 17:54:58 -07:00
parent a2d2bfc9d1
commit d9e1f20286
2 changed files with 15 additions and 14 deletions

View File

@ -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 [

View File

@ -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. ;