2009-04-18 03:37:35 -04:00
|
|
|
! Copyright (C) 2008, 2009 Slava Pestov.
|
2008-11-30 18:47:29 -05:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
USING: alien alien.c-types arrays assocs effects grouping kernel
|
2009-07-23 16:48:10 -04:00
|
|
|
parser sequences splitting words fry locals lexer namespaces
|
|
|
|
summary ;
|
2008-11-30 18:47:29 -05:00
|
|
|
IN: alien.parser
|
|
|
|
|
2009-07-23 16:48:10 -04:00
|
|
|
ERROR: invalid-c-name name ;
|
|
|
|
|
|
|
|
M: invalid-c-name summary
|
|
|
|
drop "The C pointer asterisk must be part of the type string." ;
|
|
|
|
|
|
|
|
: check-c-name ( string -- string )
|
|
|
|
dup [ CHAR: * = ] any? [ invalid-c-name ] when ;
|
|
|
|
|
2008-11-30 18:47:29 -05:00
|
|
|
: parse-arglist ( parameters return -- types effect )
|
2009-07-23 16:48:10 -04:00
|
|
|
[ 2 group unzip [ "," ?tail drop check-c-name ] map ]
|
2008-11-30 18:47:29 -05:00
|
|
|
[ [ { } ] [ 1array ] if-void ]
|
|
|
|
bi* <effect> ;
|
|
|
|
|
|
|
|
: function-quot ( return library function types -- quot )
|
|
|
|
'[ _ _ _ _ alien-invoke ] ;
|
|
|
|
|
2009-04-18 03:37:35 -04:00
|
|
|
:: make-function ( return library function parameters -- word quot effect )
|
2009-07-23 16:48:10 -04:00
|
|
|
function check-c-name create-in dup reset-generic
|
2008-11-30 18:47:29 -05:00
|
|
|
return library function
|
2009-04-18 03:37:35 -04:00
|
|
|
parameters return parse-arglist [ function-quot ] dip ;
|
|
|
|
|
|
|
|
: (FUNCTION:) ( -- word quot effect )
|
|
|
|
scan "c-library" get scan ";" parse-tokens
|
|
|
|
[ "()" subseq? not ] filter
|
|
|
|
make-function ;
|
|
|
|
|
|
|
|
: define-function ( return library function parameters -- )
|
|
|
|
make-function define-declared ;
|