moved struct wrapper code from alien.structs.structs to alien.marshall.structs
parent
9128952867
commit
e046605473
|
@ -18,10 +18,12 @@ IN: alien.marshall
|
||||||
[ define-primitive-marshallers ] each >>
|
[ define-primitive-marshallers ] each >>
|
||||||
|
|
||||||
TUPLE: alien-wrapper { underlying alien } ;
|
TUPLE: alien-wrapper { underlying alien } ;
|
||||||
|
TUPLE: struct-wrapper < alien-wrapper disposed ;
|
||||||
|
|
||||||
GENERIC: dynamic-cast ( alien-wrapper -- alien-wrapper' )
|
GENERIC: dynamic-cast ( alien-wrapper -- alien-wrapper' )
|
||||||
|
|
||||||
M: alien-wrapper dynamic-cast ;
|
M: alien-wrapper dynamic-cast ;
|
||||||
|
M: struct-wrapper dynamic-cast ;
|
||||||
|
|
||||||
: marshall-pointer ( obj -- alien )
|
: marshall-pointer ( obj -- alien )
|
||||||
{
|
{
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
Jeremy Hughes
|
|
@ -0,0 +1,37 @@
|
||||||
|
! Copyright (C) 2009 Jeremy Hughes.
|
||||||
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
|
USING: accessors alien.c-types alien.marshall arrays assocs
|
||||||
|
classes.tuple combinators destructors generalizations generic
|
||||||
|
kernel libc locals parser quotations sequences slots words ;
|
||||||
|
IN: alien.marshall.structs
|
||||||
|
|
||||||
|
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 ;
|
|
@ -1,11 +1,9 @@
|
||||||
! 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 alien.c-types alien.marshall
|
USING: accessors arrays assocs generic hashtables kernel kernel.private
|
||||||
alien.structs.fields arrays assocs byte-arrays classes.tuple
|
math namespaces parser sequences strings words libc fry
|
||||||
combinators cpu.architecture destructors fry generalizations
|
alien.c-types alien.structs.fields cpu.architecture math.order
|
||||||
generic hashtables kernel kernel.private libc locals math
|
quotations byte-arrays ;
|
||||||
math.order namespaces parser quotations sequences slots strings
|
|
||||||
words ;
|
|
||||||
IN: alien.structs
|
IN: alien.structs
|
||||||
|
|
||||||
TUPLE: struct-type
|
TUPLE: struct-type
|
||||||
|
@ -84,36 +82,3 @@ 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 ;
|
|
||||||
|
|
|
@ -4,7 +4,8 @@ USING: accessors arrays alien alien.c-types alien.structs
|
||||||
alien.arrays alien.strings kernel math namespaces parser
|
alien.arrays alien.strings kernel math namespaces parser
|
||||||
sequences words quotations math.parser splitting grouping
|
sequences words quotations math.parser splitting grouping
|
||||||
effects assocs combinators lexer strings.parser alien.parser
|
effects assocs combinators lexer strings.parser alien.parser
|
||||||
fry vocabs.parser words.constant alien.libraries ;
|
fry vocabs.parser words.constant alien.libraries
|
||||||
|
alien.marshall.structs ;
|
||||||
IN: alien.syntax
|
IN: alien.syntax
|
||||||
|
|
||||||
SYNTAX: DLL" lexer get skip-blank parse-string dlopen parsed ;
|
SYNTAX: DLL" lexer get skip-blank parse-string dlopen parsed ;
|
||||||
|
|
Loading…
Reference in New Issue