]> gitweb.factorcode.org Git - factor.git/commitdiff
make struct classes print properly in the status bar
authorJoe Groff <arcata@gmail.com>
Tue, 15 Sep 2009 20:16:53 +0000 (15:16 -0500)
committerJoe Groff <arcata@gmail.com>
Tue, 15 Sep 2009 20:16:53 +0000 (15:16 -0500)
basis/classes/struct/prettyprint/prettyprint.factor

index e88834530c54d8f9ea6caa9db20f8df12386a526..8bda9dc5f9491f92482c98058eef22e19f81867f 100644 (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> ;