1 ! Copyright (C) 2009 Jeremy Hughes.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.c-types alien.marshall arrays assocs
4 classes.tuple combinators destructors generalizations generic
5 kernel libc locals parser quotations sequences slots words
6 alien.structs lexer vocabs.parser fry effects alien.data ;
7 IN: alien.marshall.structs
10 : define-struct-accessor ( class name quot -- )
11 [ "accessors" create create-method dup make-inline ] dip define ;
13 : define-struct-getter ( class name word type -- )
14 [ ">>" append \ underlying>> ] 2dip
15 struct-field-unmarshaller \ call 4array >quotation
16 define-struct-accessor ;
18 : define-struct-setter ( class name word type -- )
19 [ "(>>" prepend ")" append ] 2dip
20 marshaller [ underlying>> ] \ bi* roll 4array >quotation
21 define-struct-accessor ;
23 : define-struct-accessors ( class name type reader writer -- )
24 [ dup define-protocol-slot ] 3dip
25 [ drop swap define-struct-getter ]
26 [ nip swap define-struct-setter ] 5 nbi ;
28 : define-struct-constructor ( class -- )
30 [ name>> "<" prepend ">" append create-in ]
32 [ name>> '[ _ malloc-object >>underlying ] append ]
34 } cleave { } swap <effect> define-declared ;
37 :: define-struct-tuple ( name -- )
38 name create-in :> class
39 class struct-wrapper { } define-tuple-class
40 class define-struct-constructor
41 name c-type fields>> [
44 [ name>> { { CHAR: space CHAR: - } } substitute ]
45 [ type>> ] [ reader>> ] [ writer>> ]
46 } cleave define-struct-accessors
49 : define-marshalled-struct ( name vocab fields -- )
50 [ define-struct ] [ 2drop define-struct-tuple ] 3bi ;