diff --git a/basis/alien/inline/authors.txt b/basis/alien/inline/authors.txt new file mode 100644 index 0000000000..845910d5a0 --- /dev/null +++ b/basis/alien/inline/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/basis/alien/inline/compiler/authors.txt b/basis/alien/inline/compiler/authors.txt new file mode 100644 index 0000000000..845910d5a0 --- /dev/null +++ b/basis/alien/inline/compiler/authors.txt @@ -0,0 +1 @@ +Jeremy Hughes diff --git a/basis/alien/inline/compiler/compiler.factor b/basis/alien/inline/compiler/compiler.factor new file mode 100644 index 0000000000..0ac702478b --- /dev/null +++ b/basis/alien/inline/compiler/compiler.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors arrays combinators fry generalizations +io.encodings.ascii io.files io.files.temp io.launcher kernel +locals sequences system ; +IN: alien.inline.compiler + +SYMBOL: C +SYMBOL: C++ + +: library-suffix ( -- str ) + os { + { [ dup macosx? ] [ drop ".dylib" ] } + { [ dup unix? ] [ drop ".so" ] } + { [ dup windows? ] [ drop ".dll" ] } + } cond ; + +: src-suffix ( lang -- str ) + { + { C [ ".c" ] } + { C++ [ ".cpp" ] } + } case ; + +:: compile-to-object ( lang contents name -- ) + name ".o" append temp-file + contents name lang src-suffix append temp-file + [ ascii set-file-contents ] keep 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 { "gcc" "-shared" "-o" } ] } + { [ dup macosx? ] + [ drop { "gcc" "-g" "-prebind" "-dynamiclib" "-o" } ] } + [ name>> "unimplemented for: " prepend throw ] + } cond prepend prepend try-process ; + +:: compile-to-library ( lang args contents name -- ) + lang contents name compile-to-object + args name link-object ; diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor new file mode 100644 index 0000000000..5e235fe74e --- /dev/null +++ b/basis/alien/inline/inline.factor @@ -0,0 +1,83 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alien.inline.compiler alien.libraries +alien.parser 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.inline + +<PRIVATE +SYMBOL: c-library +SYMBOL: library-is-c++ +SYMBOL: compiler-args +SYMBOL: c-strings + +: (C-LIBRARY:) ( -- ) + scan c-library set + V{ } clone c-strings set + V{ } clone compiler-args set ; + +: (C-LINK:) ( -- ) + "-l" scan append compiler-args get push ; + +: (C-FRAMEWORK:) ( -- ) + "-framework" scan compiler-args get '[ _ push ] bi@ ; + +: return-library-function-params ( -- return library function params ) + scan c-library get scan ")" parse-tokens + [ "(" 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 + library-is-c++ get [ "extern \"C\" " prepend ] when ; + +: library-path ( -- str ) + "lib" c-library get library-suffix + 3array concat temp-file ; + +: compile-library? ( -- ? ) + library-path dup exists? [ + current-vocab vocab-source-path + [ file-info modified>> ] bi@ <=> +lt+ = + ] [ drop t ] if ; + +: compile-library ( -- ) + library-is-c++ get [ C++ ] [ C ] if + compiler-args get + c-strings get "\n" join + c-library get compile-to-library ; + +: (;C-LIBRARY) ( -- ) + compile-library? [ compile-library ] when + c-library get library-path "cdecl" add-library ; +PRIVATE> + +SYNTAX: C-LIBRARY: (C-LIBRARY:) ; + +SYNTAX: COMPILE-AS-C++ t library-is-c++ set ; + +SYNTAX: C-LINK: (C-LINK:) ; + +SYNTAX: C-FRAMEWORK: (C-FRAMEWORK:) ; + +SYNTAX: C-LINK/FRAMEWORK: + os macosx? [ (C-FRAMEWORK:) ] [ (C-LINK:) ] if ; + +SYNTAX: C-INCLUDE: + "#include " scan append c-strings get push ; + +SYNTAX: C-FUNCTION: + return-library-function-params + [ factor-function ] + 4 nkeep (C-FUNCTION:) + " {\n" append parse-here append "\n}\n" append + c-strings get push ; + +SYNTAX: ;C-LIBRARY (;C-LIBRARY) ; diff --git a/basis/alien/inline/tests/tests.factor b/basis/alien/inline/tests/tests.factor new file mode 100644 index 0000000000..aea41ea8b8 --- /dev/null +++ b/basis/alien/inline/tests/tests.factor @@ -0,0 +1,47 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: tools.test alien.inline alien.inline.private io.files io.directories kernel ; +IN: alien.inline.tests + +C-LIBRARY: const + +C-FUNCTION: const-int add ( int a, int b ) + return a + b; +; + +;C-LIBRARY + +{ 2 1 } [ add ] must-infer-as +[ 5 ] [ 2 3 add ] unit-test + +<< library-path dup exists? [ delete-file ] [ drop ] if >> + + +C-LIBRARY: cpplib + +COMPILE-AS-C++ + +C-INCLUDE: <string> + +C-FUNCTION: const-char* hello ( ) + std::string s("hello world"); + return s.c_str(); +; + +;C-LIBRARY + +{ 0 1 } [ hello ] must-infer-as +[ "hello world" ] [ hello ] unit-test + +<< library-path dup exists? [ delete-file ] [ drop ] if >> + + +C-LIBRARY: compile-error + +C-FUNCTION: char* breakme ( ) + return not a string; +; + +<< [ (;C-LIBRARY) ] must-fail >> + +<< library-path dup exists? [ delete-file ] [ drop ] if >>