steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

prettyprint: cleanup duplicate code.

db4
John Benediktsson 2013-04-10 18:50:11 -07:00
parent d6828d38ff
commit e42144e9ea
2 changed files with 9 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/prettyprint/prettyprint.factor
View File

@ -35,6 +35,9 @@ IN: prettyprint
: short. ( obj -- ) pprint-short nl ; : short. ( obj -- ) pprint-short nl ;
: pprint-error ( obj -- str )
class-of name>> "~pprint error: " "~" surround ;
: .b ( n -- ) >bin print ; : .b ( n -- ) >bin print ;
: .o ( n -- ) >oct print ; : .o ( n -- ) >oct print ;
: .h ( n -- ) >hex print ; : .h ( n -- ) >hex print ;
@ -42,9 +45,7 @@ IN: prettyprint
: stack. ( seq -- ) : stack. ( seq -- )
[ [
[ short. ] [ [ short. ] [
drop drop [ pprint-error ] keep write-object nl
[ class-of name>> "~pprint error: " "~" surround ]
keep write-object nl
] recover ] recover
] each ; ] each ;

11
basis/ui/tools/traceback/traceback.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2006, 2010 Slava Pestov. ! Copyright (C) 2006, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays classes continuations fonts fry USING: accessors arrays continuations fonts fry inspector
inspector kernel models models.arrow prettyprint sequences kernel models models.arrow prettyprint sequences ui.commands
ui.commands ui.gadgets ui.gadgets.borders ui.gadgets.buttons ui.gadgets ui.gadgets.borders ui.gadgets.buttons
ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.labeled ui.gadgets.panes ui.gadgets.scrollers
ui.gadgets.status-bar ui.gadgets.tables ui.gadgets.tracks ui.gadgets.status-bar ui.gadgets.tables ui.gadgets.tracks
ui.gestures ui.tools.common ; ui.gestures ui.tools.common ;
@ -12,9 +12,8 @@ IN: ui.tools.traceback
TUPLE: stack-entry object string ; TUPLE: stack-entry object string ;
: <stack-entry> ( object -- stack-entry ) : <stack-entry> ( object -- stack-entry )
dup [ unparse-short ] [ dup [ unparse-short ] [ drop pprint-error ] recover
drop class-of name>> "~pprint error: " "~" surround stack-entry boa ;
] recover stack-entry boa ;
SINGLETON: stack-entry-renderer SINGLETON: stack-entry-renderer