51 lines
1.6 KiB
Factor
51 lines
1.6 KiB
Factor
|
! Copyright (C) 2009 Jeremy Hughes.
|
||
|
! See http://factorcode.org/license.txt for BSD license.
|
||
|
USING: accessors alien.inline alien.inline.types alien.marshall
|
||
|
combinators effects generalizations kernel locals make namespaces
|
||
|
quotations sequences words alien.marshall.structs lexer parser
|
||
|
vocabs.parser multiline ;
|
||
|
IN: alien.marshall.syntax
|
||
|
|
||
|
:: marshalled-function ( name types effect -- word quot effect )
|
||
|
name types effect factor-function
|
||
|
[ in>> ]
|
||
|
[ out>> types [ pointer-to-non-const-primitive? ] filter append ]
|
||
|
bi <effect>
|
||
|
[
|
||
|
[
|
||
|
types [ marshaller ] map , \ spread , ,
|
||
|
types length , \ nkeep ,
|
||
|
types [ out-arg-unmarshaller ] map
|
||
|
effect out>> dup empty?
|
||
|
[ drop ] [ first unmarshaller prefix ] if
|
||
|
, \ spread ,
|
||
|
] [ ] make
|
||
|
] dip ;
|
||
|
|
||
|
: define-c-marshalled ( name types effect body -- )
|
||
|
[
|
||
|
[ marshalled-function define-declared ]
|
||
|
[ prototype-string ] 3bi
|
||
|
] dip append-function-body c-strings get push ;
|
||
|
|
||
|
: define-c-marshalled' ( name effect body -- )
|
||
|
[
|
||
|
[ in>> ] keep
|
||
|
[ marshalled-function define-declared ]
|
||
|
[ out>> prototype-string' ] 3bi
|
||
|
] dip append-function-body c-strings get push ;
|
||
|
|
||
|
SYNTAX: CM-FUNCTION:
|
||
|
function-types-effect parse-here define-c-marshalled ;
|
||
|
|
||
|
SYNTAX: M-FUNCTION:
|
||
|
function-types-effect marshalled-function define-declared ;
|
||
|
|
||
|
SYNTAX: M-STRUCTURE:
|
||
|
scan current-vocab parse-definition
|
||
|
define-marshalled-struct ;
|
||
|
|
||
|
SYNTAX: CM-STRUCTURE:
|
||
|
scan current-vocab parse-definition
|
||
|
[ define-marshalled-struct ] [ nip define-c-struct ] 3bi ;
|