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

alien.inline: added define-c-function' and refactored existing words

db4
Jeremy Hughes 2009-07-03 23:21:21 +12:00
parent 865e37f590
commit 713e71fd3c
1 changed files with 44 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
basis/alien/inline/inline.factor
View File

@ -1,9 +1,10 @@
! Copyright (C) 2009 Jeremy Hughes. ! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.inline.compiler alien.libraries USING: accessors alien.inline.compiler alien.libraries
alien.parser arrays fry generalizations io.files io.files.info alien.parser arrays assocs effects fry generalizations grouping
io.files.temp kernel lexer math.order multiline namespaces io.files io.files.info io.files.temp kernel lexer math
sequences system vocabs.loader vocabs.parser words ; math.order math.ranges multiline namespaces sequences splitting
strings system vocabs.loader vocabs.parser words ;
IN: alien.inline IN: alien.inline
<PRIVATE <PRIVATE
@ -12,21 +13,42 @@ SYMBOL: library-is-c++
SYMBOL: compiler-args SYMBOL: compiler-args
SYMBOL: c-strings SYMBOL: c-strings
: return-library-function-params ( -- return library function params ) : function-types-effect ( -- function types effect )
scan c-library get scan ")" parse-tokens scan scan swap ")" parse-tokens
[ "(" subseq? not ] filter [ [ "(" subseq? not ] filter parse-arglist ;
[ dup CHAR: - = [ drop CHAR: space ] when ] map
] 3dip ;
: factor-function ( return library function params -- ) : types-effect>params-return ( types effect -- params return )
[ dup "const " head? [ 6 tail ] when ] 3dip [ nip out>> first ] [ in>> zip ] 2bi ;
: arg-list ( types -- params )
CHAR: a swap length CHAR: a + [a,b]
[ 1string ] map ;
: factorize-type ( str -- str' )
"const-" ?head drop ;
: cify-type ( str -- str' )
{ { CHAR: ~ CHAR: space } } substitute ;
: factor-function ( function types effect -- )
[ c-library get ] 3dip [ [ factorize-type ] map ] dip
types-effect>params-return factorize-type -roll
make-function define-declared ; make-function define-declared ;
: c-function-string ( return library function params -- str ) : prototype-string ( function types effect -- str )
[ nip ] dip [ [ cify-type ] map ] dip
" " join "(" prepend ")" append 3array " " join types-effect>params-return cify-type -rot
2 group [ " " join "," append ] map " " join
"(" prepend ")" append 3array " " join
library-is-c++ get [ "extern \"C\" " prepend ] when ; library-is-c++ get [ "extern \"C\" " prepend ] when ;
: prototype-string' ( function types return -- str )
[ dup arg-list ] <effect> prototype-string ;
: append-function-body ( prototype-str -- str )
" {\n" append parse-here append "\n}\n" append ;
: library-path ( -- str ) : library-path ( -- str )
"lib" c-library get library-suffix "lib" c-library get library-suffix
3array concat temp-file ; 3array concat temp-file ;
@ -53,10 +75,14 @@ PRIVATE>
compile-library? [ compile-library ] when compile-library? [ compile-library ] when
c-library get library-path "cdecl" add-library ; c-library get library-path "cdecl" add-library ;
: define-c-function ( return library function params -- ) : define-c-function ( function types effect -- )
[ factor-function ] 4 nkeep c-function-string [ factor-function ] 3keep prototype-string
" {\n" append parse-here append "\n}\n" append append-function-body c-strings get push ;
c-strings get push ;
: define-c-function' ( function effect -- )
[ in>> ] keep [ factor-function ] 3keep
out>> prototype-string'
append-function-body c-strings get push ;
: define-c-link ( str -- ) : define-c-link ( str -- )
"-l" prepend compiler-args get push ; "-l" prepend compiler-args get push ;
@ -82,7 +108,6 @@ SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ;
SYNTAX: C-INCLUDE: scan define-c-include ; SYNTAX: C-INCLUDE: scan define-c-include ;
SYNTAX: C-FUNCTION: SYNTAX: C-FUNCTION: function-types-effect define-c-function ;
return-library-function-params define-c-function ;
SYNTAX: ;C-LIBRARY compile-c-library ; SYNTAX: ;C-LIBRARY compile-c-library ;