moved struct wrapper code from alien.structs.structs to alien.marshall.structs

db4
Jeremy Hughes 2009-07-07 19:44:34 +12:00
parent 9128952867
commit e046605473
5 changed files with 46 additions and 40 deletions

View File

@ -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 )
{ {

View File

@ -0,0 +1 @@
Jeremy Hughes

View File

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

View File

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

View File

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