steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
extra/classes/struct/struct-tests.factor
View File

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

10
extra/classes/struct/struct.factor
View File

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