byte-length method for classes.struct STRUCTs

db4
Joe Groff 2009-08-25 19:04:29 -05:00
parent f4acf22433
commit d42edd4e3b
2 changed files with 10 additions and 1 deletions

View File

@ -30,6 +30,7 @@ STRUCT: struct-test-bar
{ foo struct-test-foo } ;
[ 12 ] [ struct-test-foo heap-size ] unit-test
[ 12 ] [ struct-test-foo <struct> byte-length ] unit-test
[ 16 ] [ struct-test-bar heap-size ] unit-test
[ 123 ] [ struct-test-foo <struct> y>> ] unit-test
[ 123 ] [ struct-test-bar <struct> foo>> y>> ] unit-test

View File

@ -94,6 +94,10 @@ M: struct-class writer-quot
[ \ struct-slot-values create-method-in ]
[ struct-slot-values-quot ] bi define ;
: (define-byte-length-method) ( class -- )
[ \ byte-length create-method-in ]
[ heap-size \ drop swap [ ] 2sequence ] bi define ;
! Struct as c-type
: slot>field ( slot -- field )
@ -172,6 +176,10 @@ M: struct-class heap-size
over [ swapd [ call( value struct -- ) ] curry keep ] [ 2drop ] if
] each ;
: (struct-methods) ( class -- )
[ (define-struct-slot-values-method) ]
[ (define-byte-length-method) ] bi ;
: (struct-word-props) ( class slots size align -- )
[
[ "struct-slots" set-word-prop ]
@ -181,7 +189,7 @@ M: struct-class heap-size
[ "struct-align" set-word-prop ] tri-curry*
[ tri ] 3curry
[ dup struct-prototype "prototype" set-word-prop ]
[ (define-struct-slot-values-method) ] tri ;
[ (struct-methods) ] tri ;
: check-struct-slots ( slots -- )
[ c-type>> c-type drop ] each ;