alien.c-syntax: fixed host of problems

basis/alien/c-syntax/c-syntax.factor

@@ -1,6 +1,6 @@
 USING: accessors alien.compile alien.libraries alien.parser
-arrays fry generalizations io.files.info io.files.temp kernel
+arrays fry generalizations io.files io.files.info io.files.temp
-lexer math.order multiline namespaces sequences system
+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
+    library-path dup exists? [
-    [ file-info modified>> ] bi@ <=> +lt+ = ;
+        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 ;

basis/alien/compile/compile.factor

@@ -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-suffix ( lang -- str )
-    [ ".src" append ] [ ".o" append ] bi [ temp-file ] bi@
+    {
-    [ tuck ascii set-file-contents ] dip
+        { "C" [ ".c" ] }
-    swap 2array { "-fPIC" "-c" "-o" } prepend
+        { "C++" [ ".cpp" ] }
-    swap prefix try-process ;
+    } 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 -- )
+: compile-to-library ( lang args contents name -- )
-    [ [ nip ] dip compile-to-object ] 4 nkeep nip link-object ;
+    [ [ nip ] dip compile-to-object ] 4 nkeep
+    nip link-object drop ;