alien.marshall: C++ type parsing

db4
Jeremy Hughes 2009-07-22 12:25:45 +12:00
parent 59091c6cf2
commit c780bb724d
2 changed files with 47 additions and 10 deletions

View File

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

View File

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