factor: trim using lists

[factor.git] / basis / classes / struct / prettyprint / prettyprint.factor

diff --git a/basis/classes/struct/prettyprint/prettyprint.factor b/basis/classes/struct/prettyprint/prettyprint.factor
index 8e75c85ad6aed669223102e4dc23ac781e8de178..500c5dbd191529a329313c0dbc6aa3f16f8f555b 100644 (file)
--- a/basis/classes/struct/prettyprint/prettyprint.factor
+++ b/basis/classes/struct/prettyprint/prettyprint.factor
@@ -1,10 +1,10 @@
-! (c)Joe Groff bsd license
-USING: accessors alien alien.c-types alien.data
-alien.prettyprint 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 ;
+! Copyright (C) 2009, 2011 Joe Groff, Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.prettyprint arrays assocs classes
+classes.struct combinators combinators.short-circuit
+continuations kernel libc make math math.parser mirrors
+prettyprint.backend prettyprint.custom prettyprint.sections
+see.private sequences slots summary ;
 IN: classes.struct.prettyprint
 
 <PRIVATE
@@ -12,13 +12,14 @@ IN: classes.struct.prettyprint
 : struct-definer-word ( class -- word )
     struct-slots
     {
-        { [ dup [ offset>> 0 = ] all? ] [ drop \ UNION-STRUCT: ] }
         { [ dup [ packed?>> ] all? ] [ drop \ PACKED-STRUCT: ] }
+        { [ dup length 1 <= ] [ drop \ STRUCT: ] }
+        { [ dup [ offset>> 0 = ] all? ] [ drop \ UNION-STRUCT: ] }
         [ drop \ STRUCT: ]
     } cond ;
 
 : struct>assoc ( struct -- assoc )
-    [ class struct-slots ] [ struct-slot-values ] bi zip ;
+    [ class-of struct-slots ] [ struct-slot-values ] bi zip ;
 
 : pprint-struct-slot ( slot -- )
     <flow \ { pprint-word
@@ -38,13 +39,13 @@ IN: classes.struct.prettyprint
 : pprint-struct ( struct -- )
     [
         [ \ S{ ] dip
-        [ class ]
+        [ class-of ]
         [ struct>assoc [ [ name>> ] dip ] assoc-map ] bi
         \ } (pprint-tuple)
     ] ?pprint-tuple ;
 
 : pprint-struct-pointer ( struct -- )
-    \ S@ [ [ class pprint-word ] [ >c-ptr pprint* ] bi ] pprint-prefix ;
+    \ S@ [ [ class-of pprint-word ] [ >c-ptr pprint* ] bi ] pprint-prefix ;
 
 PRIVATE>
 
@@ -57,7 +58,7 @@ M: struct pprint-delims
     drop \ S{ \ } ;
 
 M: struct >pprint-sequence
-    [ class ] [ struct-slot-values ] bi class-slot-sequence ;
+    [ class-of ] [ struct-slot-values ] bi class-slot-sequence ;
 
 M: struct pprint*
     [ pprint-struct ]
@@ -65,7 +66,7 @@ M: struct pprint*
 
 M: struct summary
     [
-        dup class name>> %
+        dup class-of name>> %
         " struct of " %
         byte-length #
         " bytes " %
@@ -75,19 +76,19 @@ TUPLE: struct-mirror { object read-only } ;
 C: <struct-mirror> struct-mirror
 
 : get-struct-slot ( struct slot -- value present? )
-    over class struct-slots slot-named
+    over class-of struct-slots slot-named
     [ name>> reader-word execute( struct -- value ) t ]
     [ drop f f ] if* ;
 : set-struct-slot ( value struct slot -- )
-    over class struct-slots slot-named
+    over class-of struct-slots slot-named
     [ name>> writer-word execute( value struct -- ) ]
     [ 2drop ] if* ;
 : reset-struct-slot ( struct slot -- )
-    over class struct-slots slot-named
+    over class-of struct-slots slot-named
     [ [ initial>> swap ] [ name>> writer-word ] bi execute( value struct -- ) ]
     [ drop ] if* ;
 : reset-struct-slots ( struct -- )
-    dup class struct-prototype
+    dup class-of struct-prototype
     dup byte-length memcpy ;
 
 M: struct-mirror at*
@@ -114,7 +115,7 @@ M: struct-mirror delete-at
 M: struct-mirror clear-assoc
     object>> reset-struct-slots ;
 
-M: struct-mirror >alist ( mirror -- alist )
+M: struct-mirror >alist
     object>> [
         [ drop "underlying" ] [ >c-ptr ] bi 2array 1array
     ] [