alien.structs: alien.syntax: struct wrapper and marshalling of fields
parent
296a3eb554
commit
dc9bcc8b73
|
@ -1,9 +1,11 @@
|
|||
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs generic hashtables kernel kernel.private
|
||||
math namespaces parser sequences strings words libc fry
|
||||
alien.c-types alien.structs.fields cpu.architecture math.order
|
||||
quotations byte-arrays ;
|
||||
USING: accessors alien.c-types alien.marshall
|
||||
alien.structs.fields arrays assocs byte-arrays classes.tuple
|
||||
combinators cpu.architecture destructors fry generalizations
|
||||
generic hashtables kernel kernel.private libc locals math
|
||||
math.order namespaces parser quotations sequences slots strings
|
||||
words ;
|
||||
IN: alien.structs
|
||||
|
||||
TUPLE: struct-type
|
||||
|
@ -82,3 +84,36 @@ M: struct-type stack-size
|
|||
: offset-of ( field struct -- offset )
|
||||
c-types get at fields>>
|
||||
[ name>> = ] with find nip offset>> ;
|
||||
|
||||
TUPLE: struct-wrapper < alien-wrapper disposed ;
|
||||
|
||||
M: struct-wrapper dispose* underlying>> free ;
|
||||
|
||||
: define-struct-accessor ( class name quot -- )
|
||||
[ "accessors" create create-method dup make-inline ] dip define ;
|
||||
|
||||
: define-struct-getter ( class name word type -- )
|
||||
[ ">>" append \ underlying>> ] 2dip
|
||||
unmarshaller \ call 4array >quotation
|
||||
define-struct-accessor ;
|
||||
|
||||
: define-struct-setter ( class name word type -- )
|
||||
[ "(>>" prepend ")" append ] 2dip
|
||||
marshaller [ underlying>> ] \ bi* roll 4array >quotation
|
||||
define-struct-accessor ;
|
||||
|
||||
: define-struct-accessors ( class name type reader writer -- )
|
||||
[ dup define-protocol-slot ] 3dip
|
||||
[ drop swap define-struct-getter ]
|
||||
[ nip swap define-struct-setter ] 5 nbi ;
|
||||
|
||||
:: define-struct-tuple ( name -- )
|
||||
name create-in :> class
|
||||
class struct-wrapper { } define-tuple-class
|
||||
name c-type fields>> [
|
||||
class swap
|
||||
{
|
||||
[ name>> { { CHAR: space CHAR: - } } substitute ]
|
||||
[ type>> ] [ reader>> ] [ writer>> ]
|
||||
} cleave define-struct-accessors
|
||||
] each ;
|
||||
|
|
|
@ -22,7 +22,8 @@ SYNTAX: TYPEDEF:
|
|||
scan scan typedef ;
|
||||
|
||||
SYNTAX: C-STRUCT:
|
||||
scan current-vocab parse-definition define-struct ;
|
||||
scan current-vocab parse-definition [ define-struct ] 3keep
|
||||
2drop define-struct-tuple ;
|
||||
|
||||
SYNTAX: C-UNION:
|
||||
scan parse-definition define-union ;
|
||||
|
|
Loading…
Reference in New Issue