make struct classes print properly in the status bar

Joe Groff 2009-09-15 15:16:53 -05:00
parent eadf1bc9d5
commit 4ee1a4f9e8
1 changed files with 10 additions and 9 deletions

View File

@ -1,18 +1,13 @@
! (c)Joe Groff bsd license
USING: accessors alien alien.c-types arrays assocs classes
classes.struct combinators combinators.short-circuit continuations
fry kernel libc make math math.parser mirrors prettyprint.backend
prettyprint.custom prettyprint.sections see.private sequences
slots strings summary words ;
definitions fry kernel libc make math math.parser mirrors
prettyprint.backend prettyprint.custom prettyprint.sections
see see.private sequences slots strings summary words ;
IN: classes.struct.prettyprint
<PRIVATE
: struct-definer-word ( class -- word )
struct-slots dup length 2 >=
[ second offset>> 0 = \ UNION-STRUCT: \ STRUCT: ? ]
[ drop \ STRUCT: ] if ;
: struct>assoc ( struct -- assoc )
[ class struct-slots ] [ struct-slot-values ] bi zip ;
@ -39,8 +34,14 @@ IN: classes.struct.prettyprint
PRIVATE>
M: struct-class definer
struct-slots dup length 2 >=
[ second offset>> 0 = \ UNION-STRUCT: \ STRUCT: ? ]
[ drop \ STRUCT: ] if
\ ; ;
M: struct-class see-class*
<colon dup struct-definer-word pprint-word dup pprint-word
<colon dup definer drop pprint-word dup pprint-word
<block struct-slots [ pprint-struct-slot ] each
block> pprint-; block> ;