1 ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: alien alien.c-types arrays assocs combinators effects
4 grouping kernel parser sequences splitting words fry locals
5 lexer namespaces summary math vocabs.parser ;
8 : parse-c-type-name ( name -- word/string )
11 : parse-c-type ( string -- array )
13 { [ dup "void" = ] [ drop void ] }
14 { [ CHAR: ] over member? ] [ parse-array-type parse-c-type-name prefix ] }
15 { [ dup search c-type-word? ] [ parse-c-type-name ] }
16 { [ dup c-types get at ] [ ] }
17 { [ "*" ?tail ] [ parse-c-type-name resolve-pointer-type ] }
21 : scan-c-type ( -- c-type )
23 [ drop \ } parse-until >array ]
26 : normalize-c-arg ( type name -- type' name' )
29 [ CHAR: * = ] trim-head
30 [ length - CHAR: * <array> append ] keep
32 [ parse-c-type ] dip ;
34 : parse-arglist ( parameters return -- types effect )
36 2 group [ first2 normalize-c-arg 2array ] map
37 unzip [ "," ?tail drop ] map
39 [ [ { } ] [ 1array ] if-void ]
42 : function-quot ( return library function types -- quot )
43 '[ _ _ _ _ alien-invoke ] ;
45 :: make-function ( return! library function! parameters -- word quot effect )
46 return function normalize-c-arg function! return!
47 function create-in dup reset-generic
48 return library function
49 parameters return parse-arglist [ function-quot ] dip ;
51 : (FUNCTION:) ( -- word quot effect )
52 scan "c-library" get scan ";" parse-tokens
53 [ "()" subseq? not ] filter
56 : define-function ( return library function parameters -- )
57 make-function define-declared ;