1 ! Copyright (C) 2009 Jeremy Hughes.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien.inline.compiler alien.inline.types
4 alien.libraries alien.parser arrays assocs effects fry
5 generalizations grouping io.directories io.files
6 io.files.info io.files.temp kernel lexer math math.order
7 math.ranges multiline namespaces sequences source-files
8 splitting strings system vocabs.loader vocabs.parser words
9 alien.c-types alien.structs make parser continuations ;
13 SYMBOL: library-is-c++
18 : cleanup-variables ( -- )
19 { c-library library-is-c++ linker-args c-strings }
22 : arg-list ( types -- params )
23 CHAR: a swap length CHAR: a + [a,b]
26 : compile-library? ( -- ? )
27 c-library get library-path dup exists? [
30 [ file-info modified>> ] bi@ <=> +lt+ =
34 : compile-library ( -- )
35 library-is-c++ get [ C++ ] [ C ] if
37 c-strings get "\n" join
38 c-library get compile-to-library ;
40 : c-library-name ( name -- name' )
41 [ current-vocab name>> % "_" % % ] "" make ;
44 : parse-arglist ( parameters return -- types effect )
45 [ 2 group unzip [ "," ?tail drop ] map ]
46 [ [ { } ] [ 1array ] if-void ]
49 : append-function-body ( prototype-str body -- str )
50 [ swap % " {\n" % % "\n}\n" % ] "" make ;
52 : function-types-effect ( -- function types effect )
53 scan scan swap ")" parse-tokens
54 [ "(" subseq? ] reject swap parse-arglist ;
56 : prototype-string ( function types effect -- str )
57 [ [ cify-type ] map ] dip
58 types-effect>params-return cify-type -rot
59 [ " " join ] map ", " join
60 "(" prepend ")" append 3array " " join
61 library-is-c++ get [ "extern \"C\" " prepend ] when ;
63 : prototype-string' ( function types return -- str )
64 [ dup arg-list ] <effect> prototype-string ;
66 : factor-function ( function types effect -- word quot effect )
67 annotate-effect [ c-library get ] 3dip
68 [ [ factorize-type ] map ] dip
69 types-effect>params-return factorize-type -roll
70 concat make-function ;
72 : define-c-library ( name -- )
73 c-library-name [ c-library set ] [ "c-library" set ] bi
74 V{ } clone c-strings set
75 V{ } clone linker-args set ;
77 : compile-c-library ( -- )
78 compile-library? [ compile-library ] when
79 c-library get dup library-path cdecl add-library ;
81 : define-c-function ( function types effect body -- )
83 [ factor-function define-declared ]
84 [ prototype-string ] 3bi
85 ] dip append-function-body c-strings get push ;
87 : define-c-function' ( function effect body -- )
90 [ factor-function define-declared ]
91 [ out>> prototype-string' ] 3bi
92 ] dip append-function-body c-strings get push ;
94 : c-link-to ( str -- )
95 "-l" prepend linker-args get push ;
97 : c-use-framework ( str -- )
98 "-framework" swap linker-args get '[ _ push ] bi@ ;
100 : c-link-to/use-framework ( str -- )
101 os macosx? [ c-use-framework ] [ c-link-to ] if ;
103 : c-include ( str -- )
104 "#include " prepend c-strings get push ;
106 : define-c-typedef ( old new -- )
108 [ swap "typedef " % % " " % % ";" % ]
109 "" make c-strings get push
112 : define-c-struct ( name fields -- )
113 [ current-vocab swap define-struct ] [
116 "typedef struct " % "_" % % " {\n" %
117 [ first2 swap % " " % % ";\n" % ] each
119 ] "" make c-strings get push
122 : delete-inline-library ( name -- )
123 c-library-name [ remove-library ]
124 [ library-path dup exists? [ delete-file ] [ drop ] if ] bi ;
126 : with-c-library ( name quot -- )
127 [ [ define-c-library ] dip call compile-c-library ]
128 [ cleanup-variables ] [ ] cleanup ; inline
131 [ "\n" % % "\n" % ] "" make c-strings get push ;