Merge branch 'inlinec' of git://github.com/jedahu/factor

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 {
+    compiler-descr link-descr append prepend prepend ;
-        { [ dup linux? ]
-          [ drop { "-shared" "-o" } ] }
-        { [ dup macosx? ]
-          [ drop { "-g" "-prebind" "-dynamiclib" "-o" } ] }
-        [ name>> "unimplemented for: " prepend throw ]
-    } cond swap prefix 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 ]
+    args name [ library-path ]
-    [ ".o" append ] bi [ temp-file ] bi@ 2array
+    [ ".o" append temp-file ] bi 2array
     lang link-command try-process ;
 
 :: compile-to-library ( lang args contents name -- )

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" <c-object>
+    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: <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
+
+
+DELETE-C-LIBRARY: compile-error
+C-LIBRARY: compile-error
+
+C-FUNCTION: char* breakme ( )
+    return not a string;
+;
+
+<< [ compile-c-library ] must-fail >>

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
+generalizations grouping io.directories io.files
-kernel lexer math math.order math.ranges multiline namespaces
+io.files.info io.files.temp kernel lexer math math.order
-sequences splitting strings system vocabs.loader
+math.ranges multiline namespaces sequences source-files
-vocabs.parser words ;
+splitting strings system vocabs.loader vocabs.parser words
+alien.c-types alien.structs make parser ;
 IN: alien.inline
 
 <PRIVATE
@@ -41,15 +42,12 @@ SYMBOL: c-strings
 : append-function-body ( prototype-str -- str )
     " {\n" append parse-here append "\n}\n" append ;
 
-
-: library-path ( -- str )
-    "lib" c-library get library-suffix
-    3array concat temp-file ;
-
 : compile-library? ( -- ? )
-    library-path dup exists? [
+    c-library get library-path dup exists? [
-        current-vocab vocab-source-path
+        file get [
-        [ file-info modified>> ] bi@ <=> +lt+ =
+            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 ;

basis/alien/inline/tests/tests.factor

@@ -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: <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;
-;
-
-<< [ compile-c-library ] must-fail >>
-
-<< library-path dup exists? [ delete-file ] [ drop ] if >>