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

alien.c-syntax: fixed host of problems

db4
Jeremy Hughes 2009-07-03 07:33:14 +12:00
parent acc3fc299b
commit 542e490950
2 changed files with 38 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
basis/alien/c-syntax/c-syntax.factor
View File

@ -1,6 +1,6 @@
USING: accessors alien.compile alien.libraries alien.parser
arrays fry generalizations io.files.info io.files.temp kernel
lexer math.order multiline namespaces sequences system
arrays fry generalizations io.files io.files.info io.files.temp
kernel lexer math.order multiline namespaces sequences system
vocabs.loader vocabs.parser words ;
IN: alien.c-syntax
@ -18,10 +18,17 @@ IN: alien.c-syntax
: return-library-function-params ( -- return library function params )
scan "c-library" get scan ")" parse-tokens
[ "(" subseq? not ] filter ;
[ "(" subseq? not ] filter [
[ dup CHAR: - = [ drop CHAR: space ] when ] map
] 3dip ;
: factor-function ( return library functions params -- )
[ dup "const " head? [ 6 tail ] when ] 3dip
make-function define-declared ;
: (C-FUNCTION:) ( return library function params -- str )
[ nip ] dip " " join "(" prepend ")" append 3array " " join
[ nip ] dip
" " join "(" prepend ")" append 3array " " join
"library-is-c++" get [ "extern \"C\" " prepend ] when ;
: library-path ( -- str )
@ -29,11 +36,13 @@ IN: alien.c-syntax
3array concat temp-file ;
: compile-library? ( -- ? )
library-path current-vocab vocab-source-path
[ file-info modified>> ] bi@ <=> +lt+ = ;
library-path dup exists? [
current-vocab vocab-source-path
[ file-info modified>> ] bi@ <=> +lt+ =
] [ drop t ] if ;
: compile-library ( -- )
"library-is-c++" get [ "g++" ] [ "gcc" ] if
"library-is-c++" get [ "C++" ] [ "C" ] if
"c-compiler-args" get
"c-library-vector" get "\n" join
"c-library" get compile-to-library ;
@ -52,14 +61,14 @@ SYNTAX: C-LINK: (C-LINK:) ;
SYNTAX: C-FRAMEWORK: (C-FRAMEWORK:) ;
SYNTAX: C-LINK/FRAMEWORK:
os macosx? [ (C-LINK:) ] [ (C-FRAMEWORK:) ] if ;
os macosx? [ (C-FRAMEWORK:) ] [ (C-LINK:) ] if ;
SYNTAX: C-INCLUDE:
"#include " scan append "c-library-vector" get push ;
SYNTAX: C-FUNCTION:
return-library-function-params
[ make-function define-declared ]
[ factor-function ]
4 nkeep (C-FUNCTION:)
" {\n" append parse-here append "\n}\n" append
"c-library-vector" get push ;

32
basis/alien/compile/compile.factor
View File

@ -1,4 +1,4 @@
USING: accessors arrays combinators generalizations
USING: accessors arrays combinators fry generalizations
io.encodings.ascii io.files io.files.temp io.launcher kernel
sequences system ;
IN: alien.compile
@ -10,22 +10,30 @@ IN: alien.compile
{ [ dup windows? ] [ drop ".dll" ] }
} cond ;
: compile-to-object ( compiler contents name -- )
[ ".src" append ] [ ".o" append ] bi [ temp-file ] bi@
[ tuck ascii set-file-contents ] dip
swap 2array { "-fPIC" "-c" "-o" } prepend
swap prefix try-process ;
: src-suffix ( lang -- str )
{
{ "C" [ ".c" ] }
{ "C++" [ ".cpp" ] }
} case ;
: link-object ( compiler args name -- )
: compile-to-object ( lang contents name -- )
rot '[ _ src-suffix append ] [ ".o" append ] bi
[ temp-file ] bi@
[ tuck ascii set-file-contents ] dip
swap 2array { "gcc" "-fPIC" "-c" "-o" } prepend
try-process ;
: link-object ( args name -- )
[ "lib" prepend library-suffix append ] [ ".o" append ] bi
[ temp-file ] bi@ 2array
os {
{ [ dup linux? ]
[ drop { "-shared" "-o" } ] }
[ drop { "gcc" "-shared" "-o" } ] }
{ [ dup macosx? ]
[ drop { "-g" "-prebind" "-dynamiclib" "-o" } ] }
[ drop { "gcc" "-g" "-prebind" "-dynamiclib" "-o" } ] }
[ name>> "unimplemented for: " prepend throw ]
} cond prepend prepend swap prefix try-process ;
} cond prepend prepend try-process ;
: compile-to-library ( compiler args contents name -- )
[ [ nip ] dip compile-to-object ] 4 nkeep nip link-object ;
: compile-to-library ( lang args contents name -- )
[ [ nip ] dip compile-to-object ] 4 nkeep
nip link-object drop ;