alien.marshall: C++ type parsing
parent
59091c6cf2
commit
c780bb724d
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors alien.c-types assocs combinators.short-circuit
|
||||
continuations effects fry kernel math memoize sequences
|
||||
splitting ;
|
||||
splitting strings peg.ebnf make alien.c-types ;
|
||||
IN: alien.inline.types
|
||||
|
||||
: cify-type ( str -- str' )
|
||||
|
@ -21,6 +21,9 @@ IN: alien.inline.types
|
|||
: pointer-to-const? ( str -- ? )
|
||||
cify-type "const " head? ;
|
||||
|
||||
: template-class? ( str -- ? )
|
||||
[ CHAR: < = ] any? ;
|
||||
|
||||
MEMO: resolved-primitives ( -- seq )
|
||||
primitive-types [ resolve-typedef ] map ;
|
||||
|
||||
|
@ -57,3 +60,42 @@ MEMO: resolved-primitives ( -- seq )
|
|||
[ over pointer-to-primitive? [ ">" prepend ] when ]
|
||||
assoc-map unzip
|
||||
] dip <effect> ;
|
||||
|
||||
TUPLE: c++-type name params ptr ;
|
||||
C: <c++-type> c++-type
|
||||
|
||||
EBNF: (parse-c++-type)
|
||||
dig = [0-9]
|
||||
alpha = [a-zA-Z]
|
||||
alphanum = [1-9a-zA-Z]
|
||||
name = [_a-zA-Z] [_a-zA-Z1-9]* => [[ first2 swap prefix >string ]]
|
||||
ptr = [*&] => [[ empty? not ]]
|
||||
|
||||
param = "," " "* type " "* => [[ third ]]
|
||||
|
||||
params = "<" " "* type " "* param* ">" => [[ [ 4 swap nth ] [ third ] bi prefix ]]
|
||||
|
||||
type = name " "* params? " "* ptr? => [[ { 0 2 4 } [ swap nth ] with map first3 <c++-type> ]]
|
||||
;EBNF
|
||||
|
||||
: parse-c++-type ( str -- c++-type )
|
||||
factorize-type parse-c++-type ;
|
||||
|
||||
DEFER: c++-type>string
|
||||
|
||||
: params>string ( params -- str )
|
||||
[ "<" % [ c++-type>string ] map "," join % ">" % ] "" make ;
|
||||
|
||||
: c++-type>string ( c++-type -- str )
|
||||
[
|
||||
[ name>> % ]
|
||||
[ params>> [ params>string % ] when* ]
|
||||
[ ptr>> [ "*" % ] when ]
|
||||
tri
|
||||
] "" make ;
|
||||
|
||||
GENERIC: c++-type ( obj -- c++-type/f )
|
||||
|
||||
M: object c++-type drop f ;
|
||||
|
||||
M: c++-type c-type ;
|
||||
|
|
|
@ -12,7 +12,7 @@ specialized-arrays.short specialized-arrays.uchar
|
|||
specialized-arrays.uint specialized-arrays.ulong
|
||||
specialized-arrays.ulonglong specialized-arrays.ushort strings
|
||||
unix.utilities vocabs.parser words libc.private struct-arrays
|
||||
locals generalizations ;
|
||||
locals generalizations math ;
|
||||
IN: alien.marshall
|
||||
|
||||
<< primitive-types [ [ "void*" = ] [ "bool" = ] bi or not ]
|
||||
|
@ -20,6 +20,7 @@ filter [ define-primitive-marshallers ] each >>
|
|||
|
||||
TUPLE: alien-wrapper { underlying alien } ;
|
||||
TUPLE: struct-wrapper < alien-wrapper disposed ;
|
||||
TUPLE: class-wrapper < alien-wrapper disposed ;
|
||||
|
||||
GENERIC: unmarshall-cast ( alien-wrapper -- alien-wrapper' )
|
||||
|
||||
|
@ -28,6 +29,8 @@ M: struct-wrapper unmarshall-cast ;
|
|||
|
||||
M: struct-wrapper dispose* underlying>> free ;
|
||||
|
||||
M: class-wrapper c++-type class name>> parse-c++-type ;
|
||||
|
||||
: marshall-pointer ( obj -- alien )
|
||||
{
|
||||
{ [ dup alien? ] [ ] }
|
||||
|
@ -288,16 +291,8 @@ ALIAS: marshall-void* marshall-pointer
|
|||
[ ]
|
||||
x-unmarshaller ;
|
||||
|
||||
: template-class-unmarshaller ( type -- quot/f )
|
||||
[ parse-c++-type [ name>> ] keep swap ] [ \ template-wrapper = ]
|
||||
[ '[ _ _ new swap >>type swap >>underlying unmarshall-cast ] ]
|
||||
[ drop ]
|
||||
x-unmarshaller ;
|
||||
|
||||
: non-primitive-unmarshaller ( type -- quot/f )
|
||||
{
|
||||
{ [ dup template-class? ]
|
||||
[ template-class-unmarshaller ] }
|
||||
{ [ dup pointer? ] [ class-unmarshaller ] }
|
||||
[ struct-unmarshaller ]
|
||||
} cond ;
|
||||
|
|
Loading…
Reference in New Issue