1 USING: accessors alien.c-types alien.strings arrays
2 central destructors kernel llvm.core llvm.engine
3 quotations sequences specialized-arrays.alien ;
7 : llvm-throw ( char** -- )
8 [ alien>string ] [ LLVMDisposeMessage ] bi throw ;
10 DISPOSABLE-CENTRAL: module
12 DISPOSABLE-CENTRAL: builder
13 DISPOSABLE-CENTRAL: engine
15 : <dispose> ( alien class -- disposable ) new swap >>value ;
17 TUPLE: LLVMModule value disposed ;
18 M: LLVMModule dispose* value>> LLVMDisposeModule ;
20 : <module> ( name -- module )
21 LLVMModuleCreateWithName LLVMModule <dispose> ;
23 TUPLE: LLVMModuleProvider value disposed ;
24 M: LLVMModuleProvider dispose* value>> LLVMDisposeModuleProvider ;
26 : <provider> ( -- module-provider )
27 module t >>disposed value>> LLVMCreateModuleProviderForExistingModule
28 LLVMModuleProvider <dispose> ;
30 : (add-block) ( name -- basic-block )
31 function swap LLVMAppendBasicBlock ;
33 TUPLE: LLVMBuilder value disposed ;
34 M: LLVMBuilder dispose* value>> LLVMDisposeBuilder ;
36 : <builder> ( name -- builder )
37 (add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep
38 LLVMBuilder <dispose> ;
40 TUPLE: LLVMExecutionEngine value disposed ;
41 M: LLVMExecutionEngine dispose* value>> LLVMDisposeExecutionEngine ;
43 : <engine> ( -- engine )
45 dup value>> f <void*> f <void*>
46 [ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep
47 *void* [ llvm-throw ] when* *void* LLVMExecutionEngine <dispose>
48 swap t >>disposed drop
51 : resolve-type ( callable/alien -- type )
52 dup callable? [ call( -- type ) ] when ;
54 : <function-type> ( args -- type )
56 unclip swap [ >void*-array ] keep length 0 LLVMFunctionType ;
58 : >>cc ( function calling-convention -- function )
59 dupd LLVMSetFunctionCallConv ;
61 : params>> ( function -- array )
62 dup LLVMCountParams "LLVMValueRef" <c-array> [ LLVMGetParams ] keep
63 byte-array>void*-array >array ;
65 : get-param ( name -- value )
66 function params>> swap [ swap LLVMGetValueName = ] curry find nip ;
68 : set-param-names ( names function -- )
69 params>> swap [ LLVMSetValueName ] 2each ;
71 : <function> ( args -- function )
72 module value>> over first second pick
73 [ first ] map <function-type> LLVMAddFunction LLVMCCallConv >>cc tuck
74 [ rest [ second ] map ] dip set-param-names ;
76 : global>pointer ( value -- alien ) engine value>> swap LLVMGetPointerToGlobal ;
78 : find-function ( name -- fn )
79 engine value>> swap f <void*> [ LLVMFindFunction drop ] keep *void* ;