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 >>
TUPLE: alien-wrapper { underlying alien } ;
TUPLE: struct-wrapper < alien-wrapper disposed ;
GENERIC: dynamic-cast ( alien-wrapper -- alien-wrapper' )
M: alien-wrapper dynamic-cast ;
M: struct-wrapper dynamic-cast ;
: 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.
! See http://factorcode.org/license.txt for BSD license.
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 ;
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 ;
IN: alien.structs
TUPLE: struct-type
@ -84,36 +82,3 @@ 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

@ -4,7 +4,8 @@ USING: accessors arrays alien alien.c-types alien.structs
alien.arrays alien.strings kernel math namespaces parser
sequences words quotations math.parser splitting grouping
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
SYNTAX: DLL" lexer get skip-blank parse-string dlopen parsed ;