diff --git a/basis/alien/inline/compiler/compiler.factor b/basis/alien/inline/compiler/compiler.factor index b5a7861d6b..d9f87a9f3b 100644 --- a/basis/alien/inline/compiler/compiler.factor +++ b/basis/alien/inline/compiler/compiler.factor @@ -2,7 +2,7 @@ ! 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 ; +locals make sequences system vocabs.parser words ; IN: alien.inline.compiler SYMBOL: C @@ -15,6 +15,12 @@ SYMBOL: C++ { [ dup windows? ] [ drop ".dll" ] } } cond ; +: library-path ( str -- str' ) + '[ + "lib-" % current-vocab name>> % + "-" % _ % library-suffix % + ] "" make temp-file ; + : src-suffix ( lang -- str ) { { C [ ".c" ] } @@ -27,25 +33,33 @@ SYMBOL: C++ { C++ [ "g++" ] } } case ; +HOOK: compiler-descr os ( lang -- descr ) + +M: word compiler-descr compiler 1array ; +M: macosx compiler-descr + call-next-method cpu x86.64? + [ { "-arch" "x86_64" } append ] when ; + +HOOK: link-descr os ( -- descr ) + +M: word link-descr { "-shared" "-o" } ; +M: macosx link-descr + { "-g" "-prebind" "-dynamiclib" "-o" } + cpu x86.64? [ { "-arch" "x86_64" } prepend ] when ; + : link-command ( in out lang -- descr ) - compiler os { - { [ dup linux? ] - [ drop { "-shared" "-o" } ] } - { [ dup macosx? ] - [ drop { "-g" "-prebind" "-dynamiclib" "-o" } ] } - [ name>> "unimplemented for: " prepend throw ] - } cond swap prefix prepend prepend ; + compiler-descr link-descr append prepend prepend ; :: 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 - { "-fPIC" "-c" "-o" } lang compiler prefix prepend + lang compiler-descr { "-fPIC" "-c" "-o" } append prepend try-process ; :: link-object ( lang args name -- ) - args name [ "lib" prepend library-suffix append ] - [ ".o" append ] bi [ temp-file ] bi@ 2array + args name [ library-path ] + [ ".o" append temp-file ] bi 2array lang link-command try-process ; :: compile-to-library ( lang args contents name -- ) diff --git a/basis/alien/inline/inline-tests.factor b/basis/alien/inline/inline-tests.factor new file mode 100644 index 0000000000..09b76a4bb5 --- /dev/null +++ b/basis/alien/inline/inline-tests.factor @@ -0,0 +1,72 @@ +! Copyright (C) 2009 Jeremy Hughes. +! See http://factorcode.org/license.txt for BSD license. +USING: alien.inline alien.inline.private io.directories io.files +kernel namespaces tools.test alien.c-types alien.structs ; +IN: alien.inline.tests + +DELETE-C-LIBRARY: test +C-LIBRARY: test + +C-FUNCTION: const-int add ( int a, int b ) + return a + b; +; + +C-TYPEDEF: double bigfloat + +C-FUNCTION: bigfloat smaller ( bigfloat a ) + return a / 10; +; + +C-STRUCTURE: rectangle + { "int" "width" } + { "int" "height" } ; + +C-FUNCTION: int area ( rectangle c ) + return c.width * c.height; +; + +;C-LIBRARY + +{ 2 1 } [ add ] must-infer-as +[ 5 ] [ 2 3 add ] unit-test + +[ t ] [ "double" "bigfloat" [ resolve-typedef ] bi@ = ] unit-test +{ 1 1 } [ smaller ] must-infer-as +[ 1.0 ] [ 10 smaller ] unit-test + +[ t ] [ "rectangle" resolve-typedef struct-type? ] unit-test +{ 1 1 } [ area ] must-infer-as +[ 20 ] [ + "rectangle" + 4 over set-rectangle-width + 5 over set-rectangle-height + area +] unit-test + + +DELETE-C-LIBRARY: cpplib +C-LIBRARY: cpplib + +COMPILE-AS-C++ + +C-INCLUDE: + +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 + + +DELETE-C-LIBRARY: compile-error +C-LIBRARY: compile-error + +C-FUNCTION: char* breakme ( ) + return not a string; +; + +<< [ compile-c-library ] must-fail >> diff --git a/basis/alien/inline/inline.factor b/basis/alien/inline/inline.factor index ae4a95497a..68da8b50f9 100644 --- a/basis/alien/inline/inline.factor +++ b/basis/alien/inline/inline.factor @@ -2,10 +2,11 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors alien.inline.compiler alien.inline.types alien.libraries alien.parser arrays assocs effects fry -generalizations grouping io.files io.files.info io.files.temp -kernel lexer math math.order math.ranges multiline namespaces -sequences splitting strings system vocabs.loader -vocabs.parser words ; +generalizations grouping io.directories io.files +io.files.info io.files.temp kernel lexer math math.order +math.ranges multiline namespaces sequences source-files +splitting strings system vocabs.loader vocabs.parser words +alien.c-types alien.structs make parser ; IN: alien.inline > ] bi@ <=> +lt+ = + c-library get library-path dup exists? [ + file get [ + path>> + [ file-info modified>> ] bi@ <=> +lt+ = + ] [ drop t ] if* ] [ drop t ] if ; : compile-library ( -- ) @@ -66,7 +64,7 @@ PRIVATE> : compile-c-library ( -- ) compile-library? [ compile-library ] when - c-library get library-path "cdecl" add-library ; + c-library get dup library-path "cdecl" add-library ; : define-c-function ( function types effect -- ) [ factor-function define-declared ] 3keep prototype-string @@ -89,6 +87,25 @@ PRIVATE> : define-c-include ( str -- ) "#include " prepend c-strings get push ; +: define-c-typedef ( old new -- ) + [ typedef ] [ + [ swap "typedef " % % " " % % ";" % ] + "" make c-strings get push + ] 2bi ; + +: define-c-struct ( name vocab fields -- ) + [ define-struct ] [ + nip over + [ + "typedef struct " % "_" % % " {\n" % + [ first2 swap % " " % % ";\n" % ] each + "} " % % ";\n" % + ] "" make c-strings get push + ] 3bi ; + +: delete-inline-library ( str -- ) + library-path dup exists? [ delete-file ] [ drop ] if ; + SYNTAX: C-LIBRARY: scan define-c-library ; SYNTAX: COMPILE-AS-C++ t library-is-c++ set ; @@ -104,4 +121,11 @@ SYNTAX: C-INCLUDE: scan define-c-include ; SYNTAX: C-FUNCTION: function-types-effect define-c-function ; +SYNTAX: C-TYPEDEF: scan scan define-c-typedef ; + +SYNTAX: C-STRUCTURE: + scan current-vocab parse-definition define-c-struct ; + SYNTAX: ;C-LIBRARY compile-c-library ; + +SYNTAX: DELETE-C-LIBRARY: scan delete-inline-library ; diff --git a/basis/alien/inline/tests/tests.factor b/basis/alien/inline/tests/tests.factor deleted file mode 100644 index acd2d615cd..0000000000 --- a/basis/alien/inline/tests/tests.factor +++ /dev/null @@ -1,48 +0,0 @@ -! 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: - -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; -; - -<< [ compile-c-library ] must-fail >> - -<< library-path dup exists? [ delete-file ] [ drop ] if >>