alien.structs: alien.syntax: struct wrapper and marshalling of fields
parent
296a3eb554
commit
dc9bcc8b73
|
@ -1,9 +1,11 @@
|
||||||
! Copyright (C) 2004, 2009 Slava Pestov.
|
! Copyright (C) 2004, 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors arrays assocs generic hashtables kernel kernel.private
|
USING: accessors alien.c-types alien.marshall
|
||||||
math namespaces parser sequences strings words libc fry
|
alien.structs.fields arrays assocs byte-arrays classes.tuple
|
||||||
alien.c-types alien.structs.fields cpu.architecture math.order
|
combinators cpu.architecture destructors fry generalizations
|
||||||
quotations byte-arrays ;
|
generic hashtables kernel kernel.private libc locals math
|
||||||
|
math.order namespaces parser quotations sequences slots strings
|
||||||
|
words ;
|
||||||
IN: alien.structs
|
IN: alien.structs
|
||||||
|
|
||||||
TUPLE: struct-type
|
TUPLE: struct-type
|
||||||
|
@ -82,3 +84,36 @@ M: struct-type stack-size
|
||||||
: offset-of ( field struct -- offset )
|
: offset-of ( field struct -- offset )
|
||||||
c-types get at fields>>
|
c-types get at fields>>
|
||||||
[ name>> = ] with find nip offset>> ;
|
[ 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 ;
|
scan scan typedef ;
|
||||||
|
|
||||||
SYNTAX: C-STRUCT:
|
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:
|
SYNTAX: C-UNION:
|
||||||
scan parse-definition define-union ;
|
scan parse-definition define-union ;
|
||||||
|
|
Loading…
Reference in New Issue