Merge branch 'inlinec' of git://github.com/jedahu/factor
Slava Pestov
commit
75e31b8f1e
|
|
@ -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 -- )
|
||||
|
|
|
|||
|
|
@ -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 >>
|
||||
|
|
@ -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
|
||||
|
||||
<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? [
|
||||
current-vocab vocab-source-path
|
||||
[ file-info modified>> ] 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 ;
|
||||
|
|
|
|||
|
|
@ -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 >>
|
||||
Loading…
Reference in New Issue