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 : reset-c-type ( word -- )
28 { "c-type" "pointer-c-type" } reset-props ;
30 : CREATE-C-TYPE ( -- word )
31 scan current-vocab create dup reset-c-type ;
33 : normalize-c-arg ( type name -- type' name' )
36 [ CHAR: * = ] trim-head
37 [ length - CHAR: * <array> append ] keep
39 [ parse-c-type ] dip ;
41 : parse-arglist ( parameters return -- types effect )
43 2 group [ first2 normalize-c-arg 2array ] map
44 unzip [ "," ?tail drop ] map
46 [ [ { } ] [ 1array ] if-void ]
49 : function-quot ( return library function types -- quot )
50 '[ _ _ _ _ alien-invoke ] ;
52 :: make-function ( return! library function! parameters -- word quot effect )
53 return function normalize-c-arg function! return!
54 function create-in dup reset-generic
55 return library function
56 parameters return parse-arglist [ function-quot ] dip ;
58 : (FUNCTION:) ( -- word quot effect )
59 scan "c-library" get scan ";" parse-tokens
60 [ "()" subseq? not ] filter
63 : define-function ( return library function parameters -- )
64 make-function define-declared ;
66 PREDICATE: alien-function-word < word
69 [ last \ alien-invoke eq? ]