1 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types arrays assocs
4 combinators combinators.short-circuit effects grouping
5 kernel parser sequences splitting words fry locals lexer
6 namespaces summary math vocabs.parser ;
9 : parse-c-type-name ( name -- word/string )
12 : parse-c-type ( string -- array )
14 { [ dup "void" = ] [ drop void ] }
15 { [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }
16 { [ dup search c-type-word? ] [ parse-c-type-name ] }
17 { [ dup c-types get at ] [ ] }
18 { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
22 : scan-c-type ( -- c-type )
24 [ drop \ } parse-until >array ]
27 : normalize-c-arg ( type name -- type' name' )
30 [ CHAR: * = ] trim-head
31 [ length - CHAR: * <array> append ] keep
33 [ parse-c-type ] dip ;
35 : parse-arglist ( parameters return -- types effect )
37 2 group [ first2 normalize-c-arg 2array ] map
38 unzip [ "," ?tail drop ] map
40 [ [ { } ] [ 1array ] if-void ]
43 : function-quot ( return library function types -- quot )
44 '[ _ _ _ _ alien-invoke ] ;
46 :: make-function ( return! library function! parameters -- word quot effect )
47 return function normalize-c-arg function! return!
48 function create-in dup reset-generic
49 return library function
50 parameters return parse-arglist [ function-quot ] dip ;
52 : (FUNCTION:) ( -- word quot effect )
53 scan "c-library" get scan ";" parse-tokens
54 [ "()" subseq? not ] filter
57 : define-function ( return library function parameters -- )
58 make-function define-declared ;
60 PREDICATE: alien-function-word < word
63 [ last \ alien-invoke eq? ]