make struct classes print properly in the status bar
parent
eadf1bc9d5
commit
4ee1a4f9e8
|
@ -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> ;
|
||||
|
||||
|
|
Loading…
Reference in New Issue