steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

allow FUNCTION: to parse pointers in the name field

db4
Doug Coleman 2009-07-23 18:05:09 -05:00
parent 555309ba86
commit 9bb38b870c
1 changed files with 14 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
basis/alien/parser/parser.factor
View File

@ -1,27 +1,30 @@
! Copyright (C) 2008, 2009 Slava Pestov. ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types arrays assocs effects grouping kernel USING: alien alien.c-types arrays assocs effects grouping kernel
parser sequences splitting words fry locals lexer namespaces parser sequences splitting words fry locals lexer namespaces
summary ; summary math ;
IN: alien.parser IN: alien.parser
ERROR: invalid-c-name name ; : normalize-c-arg ( type name -- type' name' )
[ length ]
M: invalid-c-name summary [
drop "The C pointer asterisk must be part of the type string." ; [ CHAR: * = ] trim-head
[ length - CHAR: * <array> append ] keep
: check-c-name ( string -- string ) ] bi ;
dup [ CHAR: * = ] any? [ invalid-c-name ] when ;
: parse-arglist ( parameters return -- types effect ) : parse-arglist ( parameters return -- types effect )
[ 2 group unzip [ "," ?tail drop check-c-name ] map ] [
2 group [ first2 normalize-c-arg 2array ] map
unzip [ "," ?tail drop check-c-name ] map
]
[ [ { } ] [ 1array ] if-void ] [ [ { } ] [ 1array ] if-void ]
bi* <effect> ; bi* <effect> ;
: function-quot ( return library function types -- quot ) : function-quot ( return library function types -- quot )
'[ _ _ _ _ alien-invoke ] ; '[ _ _ _ _ alien-invoke ] ;
:: make-function ( return library function parameters -- word quot effect ) :: make-function ( return! library function! parameters -- word quot effect )
return function normalize-c-arg function! return!
function check-c-name create-in dup reset-generic function check-c-name create-in dup reset-generic
return library function return library function
parameters return parse-arglist [ function-quot ] dip ; parameters return parse-arglist [ function-quot ] dip ;