Merge branch 'master' of git://factorcode.org/git/factor

basis/alien/inline/authors.txt

@@ -0,0 +1 @@
+Jeremy Hughes

basis/alien/inline/compiler/authors.txt

@@ -0,0 +1 @@
+Jeremy Hughes

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 ;

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) ;

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 >>

basis/compiler/tests/intrinsics.factor

@@ -238,6 +238,13 @@ IN: compiler.tests.intrinsics
 
 [ t ] [ f [ f eq? ] compile-call ] unit-test
 
+cell 8 = [
+    [ HEX: 40400000 ] [
+        HEX: 4200 [ HEX: 7fff fixnum-bitand 13 fixnum-shift-fast 112 23 fixnum-shift-fast fixnum+fast ]
+        compile-call
+    ] unit-test
+] when
+
 ! regression
 [ 3 ] [
     100001 f <array> 3 100000 pick set-nth

extra/half-floats/half-floats-tests.factor

@@ -25,6 +25,7 @@ IN: half-floats.tests
 [ -1.5  ] [ HEX: be00 bits>half ] unit-test
 [  1/0. ] [ HEX: 7c00 bits>half ] unit-test
 [ -1/0. ] [ HEX: fc00 bits>half ] unit-test
+[  3.0  ] [ HEX: 4200 bits>half ] unit-test
 [    t  ] [ HEX: 7e00 bits>half fp-nan? ] unit-test
 
 C-STRUCT: halves