alien.marshall: tidy unmarshallers
parent
1218d3fa9d
commit
8d4585edef
extra/alien/marshall
|
@ -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 ;
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue