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

alien.marshall: tidy unmarshallers

db4
Jeremy Hughes 2009-07-22 19:20:01 +12:00
parent 1218d3fa9d
commit 8d4585edef
1 changed files with 5 additions and 5 deletions
extra/alien/marshall

10
extra/alien/marshall/marshall.factor
View File

@ -275,21 +275,21 @@ ALIAS: marshall-void* marshall-pointer
: ?malloc-byte-array ( c-type -- alien ) : ?malloc-byte-array ( c-type -- alien )
dup alien? [ malloc-byte-array ] unless ; dup alien? [ malloc-byte-array ] unless ;
:: x-unmarshaller ( type type-quot wrapper-test def clean -- quot/f ) :: x-unmarshaller ( type type-quot superclass def clean -- quot/f )
type type-quot call current-vocab lookup [ type type-quot call current-vocab lookup [
dup superclasses wrapper-test any? dup superclasses superclass swap member?
[ def call ] [ drop clean call f ] if [ def call ] [ drop clean call f ] if
] [ clean call f ] if* ; inline ] [ clean call f ] if* ; inline
: struct-unmarshaller ( type -- quot/f ) : struct-unmarshaller ( type -- quot/f )
[ ] [ \ struct-wrapper = ] [ ] \ struct-wrapper
[ '[ ?malloc-byte-array _ new swap >>underlying ] ] [ '[ ?malloc-byte-array _ new swap >>underlying ] ]
[ ] [ ]
x-unmarshaller ; x-unmarshaller ;
: class-unmarshaller ( type -- quot/f ) : class-unmarshaller ( type -- quot/f )
[ type-sans-pointer ] [ \ alien-wrapper = ] [ type-sans-pointer "#" append ] \ class-wrapper
[ '[ ?malloc-byte-array _ new swap >>underlying ] ] [ '[ _ new swap >>underlying ] ]
[ ] [ ]
x-unmarshaller ; x-unmarshaller ;