alien.structs: alien.syntax: struct wrapper and marshalling of fields

db4
Jeremy Hughes 2009-07-07 15:49:39 +12:00
parent 296a3eb554
commit dc9bcc8b73
2 changed files with 41 additions and 5 deletions

View File

@ -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 ;

View File

@ -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 ;