likewise, an S@ word for structs
							parent
							
								
									dee9f56500
								
							
						
					
					
						commit
						82025bde30
					
				| 
						 | 
				
			
			@ -1,6 +1,6 @@
 | 
			
		|||
! (c)Joe Groff bsd license
 | 
			
		||||
USING: accessors assocs classes classes.struct combinators
 | 
			
		||||
kernel math prettyprint.backend prettyprint.custom
 | 
			
		||||
USING: accessors alien assocs classes classes.struct
 | 
			
		||||
combinators kernel math prettyprint.backend prettyprint.custom
 | 
			
		||||
prettyprint.sections see.private sequences strings words ;
 | 
			
		||||
IN: classes.struct.prettyprint
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			@ -24,6 +24,14 @@ IN: classes.struct.prettyprint
 | 
			
		|||
    } cleave
 | 
			
		||||
    \ } pprint-word block> ;
 | 
			
		||||
 | 
			
		||||
: pprint-struct ( struct -- )
 | 
			
		||||
    [ [ \ S{ ] dip [ class ] [ struct>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ;
 | 
			
		||||
 | 
			
		||||
: pprint-struct-pointer ( struct -- )
 | 
			
		||||
    \ S@ pprint-word
 | 
			
		||||
    [ class pprint-word ]
 | 
			
		||||
    [ >c-ptr pprint* ] bi ;
 | 
			
		||||
 | 
			
		||||
PRIVATE>
 | 
			
		||||
 | 
			
		||||
M: struct-class see-class*
 | 
			
		||||
| 
						 | 
				
			
			@ -38,4 +46,5 @@ M: struct >pprint-sequence
 | 
			
		|||
    [ class ] [ struct-slot-values ] bi class-slot-sequence ;
 | 
			
		||||
 | 
			
		||||
M: struct pprint*
 | 
			
		||||
    [ [ \ S{ ] dip [ class ] [ struct>assoc ] bi \ } (pprint-tuple) ] ?pprint-tuple ;
 | 
			
		||||
    [ pprint-struct ]
 | 
			
		||||
    [ pprint-struct-pointer ] pprint-c-object ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,7 +1,7 @@
 | 
			
		|||
! (c)Joe Groff bsd license
 | 
			
		||||
USING: accessors alien alien.c-types alien.libraries
 | 
			
		||||
alien.structs.fields alien.syntax ascii classes.struct combinators
 | 
			
		||||
destructors io.encodings.utf8 io.pathnames io.streams.string
 | 
			
		||||
alien.structs.fields alien.syntax ascii byte-arrays classes.struct
 | 
			
		||||
combinators destructors io.encodings.utf8 io.pathnames io.streams.string
 | 
			
		||||
kernel libc literals math multiline namespaces prettyprint
 | 
			
		||||
prettyprint.config see sequences specialized-arrays.ushort
 | 
			
		||||
system tools.test compiler.tree.debugger struct-arrays
 | 
			
		||||
| 
						 | 
				
			
			@ -78,16 +78,36 @@ STRUCT: struct-test-string-ptr
 | 
			
		|||
 | 
			
		||||
[ "S{ struct-test-foo { y 7654 } }" ]
 | 
			
		||||
[
 | 
			
		||||
    f boa-tuples?
 | 
			
		||||
    [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
 | 
			
		||||
    with-variable
 | 
			
		||||
    [
 | 
			
		||||
        boa-tuples? off
 | 
			
		||||
        c-object-pointers? off
 | 
			
		||||
        struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
 | 
			
		||||
    ] with-scope
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ "S@ struct-test-foo B{ 0 0 0 0 0 0 0 0 0 0 0 0 }" ]
 | 
			
		||||
[
 | 
			
		||||
    [
 | 
			
		||||
        c-object-pointers? on
 | 
			
		||||
        12 <byte-array> struct-test-foo memory>struct [ pprint ] with-string-writer
 | 
			
		||||
    ] with-scope
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ "S{ struct-test-foo f 0 7654 f }" ]
 | 
			
		||||
[
 | 
			
		||||
    t boa-tuples?
 | 
			
		||||
    [ struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer ]
 | 
			
		||||
    with-variable
 | 
			
		||||
    [
 | 
			
		||||
        boa-tuples? on
 | 
			
		||||
        c-object-pointers? off
 | 
			
		||||
        struct-test-foo <struct> 7654 >>y [ pprint ] with-string-writer
 | 
			
		||||
    ] with-scope
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ "S@ struct-test-foo f" ]
 | 
			
		||||
[
 | 
			
		||||
    [
 | 
			
		||||
        c-object-pointers? off
 | 
			
		||||
        f struct-test-foo memory>struct [ pprint ] with-string-writer
 | 
			
		||||
    ] with-scope
 | 
			
		||||
] unit-test
 | 
			
		||||
 | 
			
		||||
[ <" USING: classes.struct ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -277,6 +277,9 @@ SYNTAX: UNION-STRUCT:
 | 
			
		|||
SYNTAX: S{
 | 
			
		||||
    scan-word dup struct-slots parse-tuple-literal-slots parsed ;
 | 
			
		||||
 | 
			
		||||
SYNTAX: S@
 | 
			
		||||
    scan-word scan-object swap memory>struct parsed ;
 | 
			
		||||
 | 
			
		||||
! functor support
 | 
			
		||||
 | 
			
		||||
<PRIVATE
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue