steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
U-SLAVA-DFB8FF805\Slava 2009-07-10 07:15:25 -05:00
parent b5ca026852 4a5cb3aac3
commit e6e6490156
3 changed files with 264 additions and 33 deletions

14
basis/alien/inline/compiler/compiler.factor
View File

@ -2,12 +2,19 @@
! 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 make sequences system vocabs.parser words ;
locals make sequences system vocabs.parser words io.directories
io.pathnames ;
IN: alien.inline.compiler
SYMBOL: C
SYMBOL: C++
: inline-libs-directory ( -- path )
"alien-inline-libs" resource-path dup make-directories ;
: inline-library-file ( name -- path )
inline-libs-directory prepend-path ;
: library-suffix ( -- str )
os {
{ [ dup macosx? ] [ drop ".dylib" ] }
@ -16,10 +23,7 @@ SYMBOL: C++
} cond ;
: library-path ( str -- str' )
'[
"lib-" % current-vocab name>> %
"-" % _ % library-suffix %
] "" make temp-file ;
'[ "lib" % _ % library-suffix % ] "" make temp-file ;
: src-suffix ( lang -- str )
{

211
basis/alien/inline/inline-docs.factor Normal file
View File

@ -0,0 +1,211 @@
! Copyright (C) 2009 Jeremy Hughes.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax kernel strings effects quotations ;
IN: alien.inline
: $binding-note ( x -- )
drop
{ "This word requires that certain variables are correctly bound. "
"Call " { $link POSTPONE: define-c-library } " to set them up." } print-element ;
HELP: ;C-LIBRARY
{ $syntax ";C-LIBRARY" }
{ $description "Writes, compiles, and links code generated since previous invocation of " { $link POSTPONE: C-LIBRARY: } "." }
{ $see-also POSTPONE: compile-c-library } ;
HELP: C-FRAMEWORK:
{ $syntax "C-FRAMEWORK: name" }
{ $description "OS X only. Link to named framework. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
{ $see-also POSTPONE: c-use-framework } ;
HELP: C-FUNCTION:
{ $syntax "C-FUNCTION: return name ( args ... )\nbody\n;" }
{ $description "Appends a function to the C library in scope and defines an FFI word that calls it." }
{ $examples
{ $example
"USING: alien.inline prettyprint ;"
"IN: cmath.ffi"
""
"C-LIBRARY: cmathlib"
""
"C-FUNCTION: int add ( int a, int b )"
" return a + b;"
";"
""
";C-LIBRARY"
""
"1 2 add ."
"3" }
}
{ $see-also POSTPONE: define-c-function } ;
HELP: C-INCLUDE:
{ $syntax "C-INCLUDE: name" }
{ $description "Appends an include line to the C library in scope." }
{ $see-also POSTPONE: c-include } ;
HELP: C-LIBRARY:
{ $syntax "C-LIBRARY: name" }
{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " syntax can be used after this word." }
{ $examples
{ $example
"USING: alien.inline ;"
"IN: rectangle.ffi"
""
"C-LIBRARY: rectlib"
""
"C-STRUCTURE: rectangle { \"int\" \"width\" } { \"int\" \"height\" } ;"
""
"C-FUNCTION: int area ( rectangle c )"
" return c.width * c.height;"
";"
""
";C-LIBRARY"
"" }
}
{ $see-also POSTPONE: define-c-library } ;
HELP: C-LINK/FRAMEWORK:
{ $syntax "C-LINK/FRAMEWORK: name" }
{ $description "Equivalent to " { $link POSTPONE: C-FRAMEWORK: } " on OS X and " { $link POSTPONE: C-LINK: } " everywhere else." }
{ $see-also POSTPONE: c-link-to/use-framework } ;
HELP: C-LINK:
{ $syntax "C-LINK: name" }
{ $description "Link to named library. Takes effect when " { $link POSTPONE: ;C-LIBRARY } " is called." }
{ $see-also POSTPONE: c-link-to } ;
HELP: C-STRUCTURE:
{ $syntax "C-STRUCTURE: name pairs ... ;" }
{ $description "Like " { $snippet "C-STRUCT:" } " but also generates equivalent C code."}
{ $see-also POSTPONE: define-c-struct } ;
HELP: C-TYPEDEF:
{ $syntax "C-TYPEDEF: old new" }
{ $description "Like " { $snippet "TYPEDEF:" } " but generates a C typedef statement too." }
{ $see-also POSTPONE: define-c-typedef } ;
HELP: COMPILE-AS-C++
{ $syntax "COMPILE-AS-C++" }
{ $description "Insert this word anywhere between " { $link POSTPONE: C-LIBRARY: } " and " { $link POSTPONE: ;C-LIBRARY } " and the generated code will be treated as C++ with " { $snippet "extern \"C\"" } " prepended to each function prototype." } ;
HELP: DELETE-C-LIBRARY:
{ $syntax "DELETE-C-LIBRARY: name" }
{ $description "Deletes the shared library file corresponding to " { $snippet "name" } " . " }
{ $notes
{ $list
{ "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " }
"This word is mainly useful for unit tests."
}
}
{ $see-also POSTPONE: delete-inline-library } ;
HELP: RAW-C:
{ $syntax "RAW-C:" "body" ";" }
{ $description "Insert a string into the generated source file. Useful for macros and other details not implemented in " { $snippet "alien.inline" } "." } ;
CONSTANT: foo "abc"
HELP: compile-c-library
{ $description "Writes, compiles, and links code generated since last invocation of " { $link POSTPONE: define-c-library } ". "
"Also calls " { $snippet "add-library" } ". "
"This word does nothing if the shared library is younger than the factor source file." }
{ $notes $binding-note } ;
HELP: c-use-framework
{ $values
{ "str" string }
}
{ $description "OS X only. Adds " { $snippet "-framework name" } " to linker command." }
{ $notes $binding-note }
{ $see-also c-link-to c-link-to/use-framework } ;
HELP: define-c-function
{ $values
{ "function" "function name" } { "types" "a sequence of C types" } { "effect" effect } { "body" string }
}
{ $description "Defines a C function and a factor word which calls it." }
{ $notes
{ $list
{ "The number of " { $snippet "types" } " must match the " { $snippet "in" } " count of the " { $snippet "effect" } "." }
{ "There must be only one " { $snippet "out" } " element. It must be a legal C return type with dashes (-) instead of spaces." }
$binding-note
}
}
{ $see-also POSTPONE: define-c-function' } ;
HELP: define-c-function'
{ $values
{ "function" "function name" } { "effect" effect } { "body" string }
}
{ $description "Defines a C function and a factor word which calls it. See " { $link define-c-function } " for more information." }
{ $notes
{ $list
{ "Each effect element must be a legal C type with dashes (-) instead of spaces. "
"C argument names will be generated alphabetically, starting with " { $snippet "a" } "." }
$binding-note
}
}
{ $see-also define-c-function } ;
HELP: c-include
{ $values
{ "str" string }
}
{ $description "Appends an include line to the C library in scope." }
{ $notes $binding-note } ;
HELP: define-c-library
{ $values
{ "name" string }
}
{ $description "Starts a new C library scope. Other " { $snippet "alien.inline" } " words can be used after this one." } ;
HELP: c-link-to
{ $values
{ "str" string }
}
{ $description "Adds " { $snippet "-lname" } " to linker command." }
{ $notes $binding-note }
{ $see-also c-use-framework c-link-to/use-framework } ;
HELP: c-link-to/use-framework
{ $values
{ "str" string }
}
{ $description "Equivalent to " { $link c-use-framework } " on OS X and " { $link c-link-to } " everywhere else." }
{ $notes $binding-note }
{ $see-also c-link-to c-use-framework } ;
HELP: define-c-struct
{ $values
{ "name" string } { "fields" "type/name pairs" }
}
{ $description "Defines a C struct and factor words which operate on it." }
{ $notes $binding-note } ;
HELP: define-c-typedef
{ $values
{ "old" "C type" } { "new" "C type" }
}
{ $description "Define C and factor typedefs." }
{ $notes $binding-note } ;
HELP: delete-inline-library
{ $values
{ "name" string }
}
{ $description "Delete the shared library file corresponding to " { $snippet "name" } "." }
{ $notes "Must be executed in the vocabulary where " { $snippet "name" } " is defined. " } ;
HELP: with-c-library
{ $values
{ "name" string } { "quot" quotation }
}
{ $description "Calls " { $link define-c-library } ", then the quotation, then " { $link compile-c-library } ", then sets all variables bound by " { $snippet "define-c-library" } " to " { $snippet "f" } "." } ;
ARTICLE: "alien.inline" "Inline C"
{ $vocab-link "alien.inline" }
;
ABOUT: "alien.inline"

72
basis/alien/inline/inline.factor
View File

@ -6,7 +6,7 @@ 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 ;
alien.c-types alien.structs make parser continuations ;
IN: alien.inline
<PRIVATE
@ -15,6 +15,10 @@ SYMBOL: library-is-c++
SYMBOL: compiler-args
SYMBOL: c-strings
: cleanup-variables ( -- )
{ c-library library-is-c++ compiler-args c-strings }
[ off ] each ;
: function-types-effect ( -- function types effect )
scan scan swap ")" parse-tokens
[ "(" subseq? not ] filter swap parse-arglist ;
@ -39,8 +43,8 @@ SYMBOL: c-strings
: prototype-string' ( function types return -- str )
[ dup arg-list ] <effect> prototype-string ;
: append-function-body ( prototype-str -- str )
" {\n" append parse-here append "\n}\n" append ;
: append-function-body ( prototype-str body -- str )
[ swap % " {\n" % % "\n}\n" % ] "" make ;
: compile-library? ( -- ? )
c-library get library-path dup exists? [
@ -55,10 +59,13 @@ SYMBOL: c-strings
compiler-args get
c-strings get "\n" join
c-library get compile-to-library ;
: c-library-name ( name -- name' )
[ current-vocab name>> % "_" % % ] "" make ;
PRIVATE>
: define-c-library ( name -- )
c-library set
c-library-name c-library set
V{ } clone c-strings set
V{ } clone compiler-args set ;
@ -66,25 +73,29 @@ PRIVATE>
compile-library? [ compile-library ] when
c-library get dup library-path "cdecl" add-library ;
: define-c-function ( function types effect -- )
[ factor-function define-declared ] 3keep prototype-string
append-function-body c-strings get push ;
: define-c-function ( function types effect body -- )
[
[ factor-function define-declared ]
[ prototype-string ] 3bi
] dip append-function-body c-strings get push ;
: define-c-function' ( function effect -- )
[ in>> ] keep [ factor-function define-declared ] 3keep
out>> prototype-string'
append-function-body c-strings get push ;
: define-c-function' ( function effect body -- )
[
[ in>> ] keep
[ factor-function define-declared ]
[ out>> prototype-string' ] 3bi
] dip append-function-body c-strings get push ;
: define-c-link ( str -- )
: c-link-to ( str -- )
"-l" prepend compiler-args get push ;
: define-c-framework ( str -- )
: c-use-framework ( str -- )
"-framework" swap compiler-args get '[ _ push ] bi@ ;
: define-c-link/framework ( str -- )
os macosx? [ define-c-framework ] [ define-c-link ] if ;
: c-link-to/use-framework ( str -- )
os macosx? [ c-use-framework ] [ c-link-to ] if ;
: define-c-include ( str -- )
: c-include ( str -- )
"#include " prepend c-strings get push ;
: define-c-typedef ( old new -- )
@ -93,38 +104,43 @@ PRIVATE>
"" make c-strings get push
] 2bi ;
: define-c-struct ( name vocab fields -- )
[ define-struct ] [
nip over
: define-c-struct ( name fields -- )
[ current-vocab swap define-struct ] [
over
[
"typedef struct " % "_" % % " {\n" %
[ first2 swap % " " % % ";\n" % ] each
"} " % % ";\n" %
] "" make c-strings get push
] 3bi ;
] 2bi ;
: delete-inline-library ( str -- )
library-path dup exists? [ delete-file ] [ drop ] if ;
: delete-inline-library ( name -- )
c-library-name [ remove-library ]
[ library-path dup exists? [ delete-file ] [ drop ] if ] bi ;
: with-c-library ( name quot -- )
[ [ define-c-library ] dip call compile-c-library ]
[ cleanup-variables ] [ ] cleanup ; inline
SYNTAX: C-LIBRARY: scan define-c-library ;
SYNTAX: COMPILE-AS-C++ t library-is-c++ set ;
SYNTAX: C-LINK: scan define-c-link ;
SYNTAX: C-LINK: scan c-link-to ;
SYNTAX: C-FRAMEWORK: scan define-c-framework ;
SYNTAX: C-FRAMEWORK: scan c-use-framework ;
SYNTAX: C-LINK/FRAMEWORK: scan define-c-link/framework ;
SYNTAX: C-LINK/FRAMEWORK: scan c-link-to/use-framework ;
SYNTAX: C-INCLUDE: scan define-c-include ;
SYNTAX: C-INCLUDE: scan c-include ;
SYNTAX: C-FUNCTION:
function-types-effect define-c-function ;
function-types-effect parse-here define-c-function ;
SYNTAX: C-TYPEDEF: scan scan define-c-typedef ;
SYNTAX: C-STRUCTURE:
scan current-vocab parse-definition define-c-struct ;
scan parse-definition define-c-struct ;
SYNTAX: ;C-LIBRARY compile-c-library ;