Merge branch 'llvm' of git://github.com/yuuki/factor

db4
Slava Pestov 2009-07-09 06:21:44 -05:00
commit 5536237232
20 changed files with 1050 additions and 0 deletions

View File

@ -0,0 +1 @@
Matthew Willis

View File

@ -0,0 +1,16 @@
USING: central destructors help.markup help.syntax ;
HELP: CENTRAL:
{ $description
"This parsing word defines a pair of words useful for "
"implementing the \"central\" pattern: " { $snippet "symbol" } " and "
{ $snippet "with-symbol" } ". This is a middle ground between excessive "
"stack manipulation and full-out locals, meant to solve the case where "
"one object is operated on by several related words."
} ;
HELP: DISPOSABLE-CENTRAL:
{ $description
"Like " { $link POSTPONE: CENTRAL: } ", but generates " { $snippet "with-" }
" words that are wrapped in a " { $link with-disposal } "."
} ;

View File

@ -0,0 +1,19 @@
USING: accessors central destructors kernel math tools.test ;
IN: scratchpad
CENTRAL: test-central
[ 3 ] [ 3 [ test-central ] with-test-central ] unit-test
TUPLE: test-disp-cent value disposed ;
! A phony destructor that adds 1 to the value so we can make sure it got called.
M: test-disp-cent dispose* dup value>> 1+ >>value drop ;
DISPOSABLE-CENTRAL: t-d-c
: test-t-d-c ( -- n )
test-disp-cent new 3 >>value [ t-d-c ] with-t-d-c value>> ;
[ 4 ] [ test-t-d-c ] unit-test

View File

@ -0,0 +1,28 @@
USING: destructors kernel lexer namespaces parser sequences words ;
IN: central
: define-central-getter ( word -- )
dup [ get ] curry (( -- obj )) define-declared ;
: define-centrals ( str -- getter setter )
[ create-in dup define-central-getter ]
[ "with-" prepend create-in dup make-inline ] bi ;
: central-setter-def ( word with-word -- with-word quot )
[ with-variable ] with ;
: disposable-setter-def ( word with-word -- with-word quot )
[ pick [ drop with-variable ] with-disposal ] with ;
: declare-central ( with-word quot -- ) (( object quot -- )) define-declared ;
: define-central ( word-name -- )
define-centrals central-setter-def declare-central ;
: define-disposable-central ( word-name -- )
define-centrals disposable-setter-def declare-central ;
SYNTAX: CENTRAL: ( -- ) scan define-central ;
SYNTAX: DISPOSABLE-CENTRAL: ( -- ) scan define-disposable-central ;

1
extra/central/tags.txt Normal file
View File

@ -0,0 +1 @@
extensions

1
extra/llvm/authors.txt Normal file
View File

@ -0,0 +1 @@
Matthew Willis

418
extra/llvm/core/core.factor Normal file
View File

@ -0,0 +1,418 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.libraries alien.syntax ;
IN: llvm.core
<<
"LLVMSystem" "/usr/local/lib/libLLVMSystem.dylib" "cdecl" add-library
"LLVMSupport" "/usr/local/lib/libLLVMSupport.dylib" "cdecl" add-library
"LLVMCore" "/usr/local/lib/libLLVMCore.dylib" "cdecl" add-library
"LLVMBitReader" "/usr/local/lib/libLLVMBitReader.dylib" "cdecl" add-library
>>
! llvm-c/Core.h
LIBRARY: LLVMCore
TYPEDEF: uint unsigned
TYPEDEF: unsigned enum
CONSTANT: LLVMZExtAttribute BIN: 1
CONSTANT: LLVMSExtAttribute BIN: 10
CONSTANT: LLVMNoReturnAttribute BIN: 100
CONSTANT: LLVMInRegAttribute BIN: 1000
CONSTANT: LLVMStructRetAttribute BIN: 10000
CONSTANT: LLVMNoUnwindAttribute BIN: 100000
CONSTANT: LLVMNoAliasAttribute BIN: 1000000
CONSTANT: LLVMByValAttribute BIN: 10000000
CONSTANT: LLVMNestAttribute BIN: 100000000
CONSTANT: LLVMReadNoneAttribute BIN: 1000000000
CONSTANT: LLVMReadOnlyAttribute BIN: 10000000000
TYPEDEF: enum LLVMAttribute;
C-ENUM:
LLVMVoidTypeKind
LLVMFloatTypeKind
LLVMDoubleTypeKind
LLVMX86_FP80TypeKind
LLVMFP128TypeKind
LLVMPPC_FP128TypeKind
LLVMLabelTypeKind
LLVMMetadataTypeKind
LLVMIntegerTypeKind
LLVMFunctionTypeKind
LLVMStructTypeKind
LLVMArrayTypeKind
LLVMPointerTypeKind
LLVMOpaqueTypeKind
LLVMVectorTypeKind ;
TYPEDEF: enum LLVMTypeKind
C-ENUM:
LLVMExternalLinkage
LLVMLinkOnceLinkage
LLVMWeakLinkage
LLVMAppendingLinkage
LLVMInternalLinkage
LLVMDLLImportLinkage
LLVMDLLExportLinkage
LLVMExternalWeakLinkage
LLVMGhostLinkage ;
TYPEDEF: enum LLVMLinkage
C-ENUM:
LLVMDefaultVisibility
LLVMHiddenVisibility
LLVMProtectedVisibility ;
TYPEDEF: enum LLVMVisibility
CONSTANT: LLVMCCallConv 0
CONSTANT: LLVMFastCallConv 8
CONSTANT: LLVMColdCallConv 9
CONSTANT: LLVMX86StdcallCallConv 64
CONSTANT: LLVMX86FastcallCallConv 65
TYPEDEF: enum LLVMCallConv
CONSTANT: LLVMIntEQ 32
CONSTANT: LLVMIntNE 33
CONSTANT: LLVMIntUGT 34
CONSTANT: LLVMIntUGE 35
CONSTANT: LLVMIntULT 36
CONSTANT: LLVMIntULE 37
CONSTANT: LLVMIntSGT 38
CONSTANT: LLVMIntSGE 39
CONSTANT: LLVMIntSLT 40
CONSTANT: LLVMIntSLE 41
TYPEDEF: enum LLVMIntPredicate
C-ENUM:
LLVMRealPredicateFalse
LLVMRealOEQ
LLVMRealOGT
LLVMRealOGE
LLVMRealOLT
LLVMRealOLE
LLVMRealONE
LLVMRealORD
LLVMRealUNO
LLVMRealUEQ
LLVMRealUGT
LLVMRealUGE
LLVMRealULT
LLVMRealULE
LLVMRealUNE
LLVMRealPredicateTrue ;
TYPEDEF: enum LLVMRealPredicate
! Opaque Types
TYPEDEF: void* LLVMModuleRef
TYPEDEF: void* LLVMPassManagerRef
TYPEDEF: void* LLVMModuleProviderRef
TYPEDEF: void* LLVMTypeRef
TYPEDEF: void* LLVMTypeHandleRef
TYPEDEF: void* LLVMValueRef
TYPEDEF: void* LLVMBasicBlockRef
TYPEDEF: void* LLVMBuilderRef
TYPEDEF: void* LLVMMemoryBufferRef
! Functions
FUNCTION: void LLVMDisposeMessage ( char* Message ) ;
FUNCTION: LLVMModuleRef LLVMModuleCreateWithName ( char* ModuleID ) ;
FUNCTION: int LLVMAddTypeName ( LLVMModuleRef M, char* Name, LLVMTypeRef Ty ) ;
FUNCTION: void LLVMDisposeModule ( LLVMModuleRef M ) ;
FUNCTION: void LLVMDumpModule ( LLVMModuleRef M ) ;
FUNCTION: LLVMModuleProviderRef
LLVMCreateModuleProviderForExistingModule ( LLVMModuleRef M ) ;
FUNCTION: void LLVMDisposeModuleProvider ( LLVMModuleProviderRef MP ) ;
! Types
! LLVM types conform to the following hierarchy:
!
! types:
! integer type
! real type
! function type
! sequence types:
! array type
! pointer type
! vector type
! void type
! label type
! opaque type
! See llvm::LLVMTypeKind::getTypeID.
FUNCTION: LLVMTypeKind LLVMGetTypeKind ( LLVMTypeRef Ty ) ;
! Operations on integer types
FUNCTION: LLVMTypeRef LLVMInt1Type ( ) ;
FUNCTION: LLVMTypeRef LLVMInt8Type ( ) ;
FUNCTION: LLVMTypeRef LLVMInt16Type ( ) ;
FUNCTION: LLVMTypeRef LLVMInt32Type ( ) ;
FUNCTION: LLVMTypeRef LLVMInt64Type ( ) ;
FUNCTION: LLVMTypeRef LLVMIntType ( unsigned NumBits ) ;
FUNCTION: unsigned LLVMGetIntTypeWidth ( LLVMTypeRef IntegerTy ) ;
! Operations on real types
FUNCTION: LLVMTypeRef LLVMFloatType ( ) ;
FUNCTION: LLVMTypeRef LLVMDoubleType ( ) ;
FUNCTION: LLVMTypeRef LLVMX86FP80Type ( ) ;
FUNCTION: LLVMTypeRef LLVMFP128Type ( ) ;
FUNCTION: LLVMTypeRef LLVMPPCFP128Type ( ) ;
! Operations on function types
FUNCTION: LLVMTypeRef
LLVMFunctionType ( LLVMTypeRef ReturnType, LLVMTypeRef* ParamTypes, unsigned ParamCount, int IsVarArg ) ;
FUNCTION: int LLVMIsFunctionVarArg ( LLVMTypeRef FunctionTy ) ;
FUNCTION: LLVMTypeRef LLVMGetReturnType ( LLVMTypeRef FunctionTy ) ;
FUNCTION: unsigned LLVMCountParamTypes ( LLVMTypeRef FunctionTy ) ;
FUNCTION: void LLVMGetParamTypes ( LLVMTypeRef FunctionTy, LLVMTypeRef* Dest ) ;
! Operations on struct types
FUNCTION: LLVMTypeRef
LLVMStructType ( LLVMTypeRef* ElementTypes, unsigned ElementCount, int Packed ) ;
FUNCTION: unsigned LLVMCountStructElementTypes ( LLVMTypeRef StructTy ) ;
FUNCTION: void LLVMGetStructElementTypes ( LLVMTypeRef StructTy, LLVMTypeRef* Dest ) ;
FUNCTION: int LLVMIsPackedStruct ( LLVMTypeRef StructTy ) ;
! Operations on array, pointer, and vector types (sequence types)
FUNCTION: LLVMTypeRef LLVMArrayType ( LLVMTypeRef ElementType, unsigned ElementCount ) ;
FUNCTION: LLVMTypeRef LLVMPointerType ( LLVMTypeRef ElementType, unsigned AddressSpace ) ;
FUNCTION: LLVMTypeRef LLVMVectorType ( LLVMTypeRef ElementType, unsigned ElementCount ) ;
FUNCTION: LLVMTypeRef LLVMGetElementType ( LLVMTypeRef Ty ) ;
FUNCTION: unsigned LLVMGetArrayLength ( LLVMTypeRef ArrayTy ) ;
FUNCTION: unsigned LLVMGetPointerAddressSpace ( LLVMTypeRef PointerTy ) ;
FUNCTION: unsigned LLVMGetVectorSize ( LLVMTypeRef VectorTy ) ;
! Operations on other types
FUNCTION: LLVMTypeRef LLVMVoidType ( ) ;
FUNCTION: LLVMTypeRef LLVMLabelType ( ) ;
FUNCTION: LLVMTypeRef LLVMOpaqueType ( ) ;
! Operations on type handles
FUNCTION: LLVMTypeHandleRef LLVMCreateTypeHandle ( LLVMTypeRef PotentiallyAbstractTy ) ;
FUNCTION: void LLVMRefineType ( LLVMTypeRef AbstractTy, LLVMTypeRef ConcreteTy ) ;
FUNCTION: LLVMTypeRef LLVMResolveTypeHandle ( LLVMTypeHandleRef TypeHandle ) ;
FUNCTION: void LLVMDisposeTypeHandle ( LLVMTypeHandleRef TypeHandle ) ;
! Types end
FUNCTION: unsigned LLVMCountParams ( LLVMValueRef Fn ) ;
FUNCTION: void LLVMGetParams ( LLVMValueRef Fn, LLVMValueRef* Params ) ;
FUNCTION: LLVMValueRef
LLVMAddFunction ( LLVMModuleRef M, char* Name, LLVMTypeRef FunctionTy ) ;
FUNCTION: LLVMValueRef LLVMGetFirstFunction ( LLVMModuleRef M ) ;
FUNCTION: LLVMValueRef LLVMGetNextFunction ( LLVMValueRef Fn ) ;
FUNCTION: unsigned LLVMGetFunctionCallConv ( LLVMValueRef Fn ) ;
FUNCTION: void LLVMSetFunctionCallConv ( LLVMValueRef Fn, unsigned CC ) ;
FUNCTION: LLVMBasicBlockRef
LLVMAppendBasicBlock ( LLVMValueRef Fn, char* Name ) ;
FUNCTION: LLVMValueRef LLVMGetBasicBlockParent ( LLVMBasicBlockRef BB ) ;
! Values
FUNCTION: LLVMTypeRef LLVMTypeOf ( LLVMValueRef Val ) ;
FUNCTION: char* LLVMGetValueName ( LLVMValueRef Val ) ;
FUNCTION: void LLVMSetValueName ( LLVMValueRef Val, char* Name ) ;
FUNCTION: void LLVMDumpValue ( LLVMValueRef Val ) ;
! Instruction Builders
FUNCTION: LLVMBuilderRef LLVMCreateBuilder ( ) ;
FUNCTION: void LLVMPositionBuilder
( LLVMBuilderRef Builder, LLVMBasicBlockRef Block, LLVMValueRef Instr ) ;
FUNCTION: void LLVMPositionBuilderBefore
( LLVMBuilderRef Builder, LLVMValueRef Instr ) ;
FUNCTION: void LLVMPositionBuilderAtEnd
( LLVMBuilderRef Builder, LLVMBasicBlockRef Block ) ;
FUNCTION: LLVMBasicBlockRef LLVMGetInsertBlock
( LLVMBuilderRef Builder ) ;
FUNCTION: void LLVMClearInsertionPosition
( LLVMBuilderRef Builder ) ;
FUNCTION: void LLVMInsertIntoBuilder
( LLVMBuilderRef Builder, LLVMValueRef Instr ) ;
FUNCTION: void LLVMDisposeBuilder
( LLVMBuilderRef Builder ) ;
! IB Terminators
FUNCTION: LLVMValueRef LLVMBuildRetVoid
( LLVMBuilderRef Builder ) ;
FUNCTION: LLVMValueRef LLVMBuildRet
( LLVMBuilderRef Builder, LLVMValueRef V ) ;
FUNCTION: LLVMValueRef LLVMBuildBr
( LLVMBuilderRef Builder, LLVMBasicBlockRef Dest ) ;
FUNCTION: LLVMValueRef LLVMBuildCondBr
( LLVMBuilderRef Builder, LLVMValueRef If, LLVMBasicBlockRef Then, LLVMBasicBlockRef Else ) ;
FUNCTION: LLVMValueRef LLVMBuildSwitch
( LLVMBuilderRef Builder, LLVMValueRef V, LLVMBasicBlockRef Else, unsigned NumCases ) ;
FUNCTION: LLVMValueRef LLVMBuildInvoke
( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs,
LLVMBasicBlockRef Then, LLVMBasicBlockRef Catch, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildUnwind
( LLVMBuilderRef Builder ) ;
FUNCTION: LLVMValueRef LLVMBuildUnreachable
( LLVMBuilderRef Builder ) ;
! IB Add Case to Switch
FUNCTION: void LLVMAddCase
( LLVMValueRef Switch, LLVMValueRef OnVal, LLVMBasicBlockRef Dest ) ;
! IB Arithmetic
FUNCTION: LLVMValueRef LLVMBuildAdd
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSub
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildMul
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildUDiv
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSDiv
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFDiv
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildURem
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSRem
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFRem
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildShl
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildLShr
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildAShr
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildAnd
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildOr
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildXor
( LLVMBuilderRef Builder, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildNeg
( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildNot
( LLVMBuilderRef Builder, LLVMValueRef V, char* Name ) ;
! IB Memory
FUNCTION: LLVMValueRef LLVMBuildMalloc
( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildArrayMalloc
( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildAlloca
( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildArrayAlloca
( LLVMBuilderRef Builder, LLVMTypeRef Ty, LLVMValueRef Val, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFree
( LLVMBuilderRef Builder, LLVMValueRef PointerVal ) ;
FUNCTION: LLVMValueRef LLVMBuildLoad
( LLVMBuilderRef Builder, LLVMValueRef PointerVal, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildStore
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMValueRef Ptr ) ;
FUNCTION: LLVMValueRef LLVMBuildGEP
( LLVMBuilderRef B, LLVMValueRef Pointer, LLVMValueRef* Indices,
unsigned NumIndices, char* Name ) ;
! IB Casts
FUNCTION: LLVMValueRef LLVMBuildTrunc
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildZExt
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSExt
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPToUI
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPToSI
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildUIToFP
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSIToFP
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPTrunc
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFPExt
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildPtrToInt
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildIntToPtr
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildBitCast
( LLVMBuilderRef Builder, LLVMValueRef Val, LLVMTypeRef DestTy, char* Name ) ;
! IB Comparisons
FUNCTION: LLVMValueRef LLVMBuildICmp
( LLVMBuilderRef Builder, LLVMIntPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildFCmp
( LLVMBuilderRef Builder, LLVMRealPredicate Op, LLVMValueRef LHS, LLVMValueRef RHS, char* Name ) ;
! IB Misc Instructions
FUNCTION: LLVMValueRef LLVMBuildPhi
( LLVMBuilderRef Builder, LLVMTypeRef Ty, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildCall
( LLVMBuilderRef Builder, LLVMValueRef Fn, LLVMValueRef* Args, unsigned NumArgs, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildSelect
( LLVMBuilderRef Builder, LLVMValueRef If, LLVMValueRef Then, LLVMValueRef Else, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildVAArg
( LLVMBuilderRef Builder, LLVMValueRef List, LLVMTypeRef Ty, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildExtractElement
( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef Index, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildInsertElement
( LLVMBuilderRef Builder, LLVMValueRef VecVal, LLVMValueRef EltVal, LLVMValueRef Index, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildShuffleVector
( LLVMBuilderRef Builder, LLVMValueRef V1, LLVMValueRef V2, LLVMValueRef Mask, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildExtractValue
( LLVMBuilderRef Builder, LLVMValueRef AggVal, unsigned Index, char* Name ) ;
FUNCTION: LLVMValueRef LLVMBuildInsertValue
( LLVMBuilderRef Builder, LLVMValueRef AggVal, LLVMValueRef EltVal, unsigned Index, char* Name ) ;
! Memory Buffers/Bit Reader
FUNCTION: int LLVMCreateMemoryBufferWithContentsOfFile
( char* Path, LLVMMemoryBufferRef* OutMemBuf, char** OutMessage ) ;
FUNCTION: void LLVMDisposeMemoryBuffer ( LLVMMemoryBufferRef MemBuf ) ;
LIBRARY: LLVMBitReader
FUNCTION: int LLVMParseBitcode
( LLVMMemoryBufferRef MemBuf, LLVMModuleRef* OutModule, char** OutMessage ) ;
FUNCTION: int LLVMGetBitcodeModuleProvider
( LLVMMemoryBufferRef MemBuf, LLVMModuleProviderRef* OutMP, char** OutMessage ) ;

View File

@ -0,0 +1,68 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.libraries alien.syntax llvm.core ;
IN: llvm.engine
<<
"LLVMExecutionEngine" "/usr/local/lib/libLLVMExecutionEngine.dylib" "cdecl" add-library
"LLVMTarget" "/usr/local/lib/libLLVMTarget.dylib" "cdecl" add-library
"LLVMAnalysis" "/usr/local/lib/libLLVMAnalysis.dylib" "cdecl" add-library
"LLVMipa" "/usr/local/lib/libLLVMipa.dylib" "cdecl" add-library
"LLVMTransformUtils" "/usr/local/lib/libLLVMTransformUtils.dylib" "cdecl" add-library
"LLVMScalarOpts" "/usr/local/lib/libLLVMScalarOpts.dylib" "cdecl" add-library
"LLVMCodeGen" "/usr/local/lib/libLLVMCodeGen.dylib" "cdecl" add-library
"LLVMAsmPrinter" "/usr/local/lib/libLLVMAsmPrinter.dylib" "cdecl" add-library
"LLVMSelectionDAG" "/usr/local/lib/libLLVMSelectionDAG.dylib" "cdecl" add-library
"LLVMX86CodeGen" "/usr/local/lib/libLLVMX86CodeGen.dylib" "cdecl" add-library
"LLVMJIT" "/usr/local/lib/libLLVMJIT.dylib" "cdecl" add-library
"LLVMInterpreter.dylib" "/usr/local/lib/libLLVMInterpreter.dylib" "cdecl" add-library
>>
! llvm-c/ExecutionEngine.h
LIBRARY: LLVMExecutionEngine
TYPEDEF: void* LLVMGenericValueRef
TYPEDEF: void* LLVMExecutionEngineRef
FUNCTION: LLVMGenericValueRef LLVMCreateGenericValueOfInt
( LLVMTypeRef Ty, ulonglong N, int IsSigned ) ;
FUNCTION: ulonglong LLVMGenericValueToInt
( LLVMGenericValueRef GenVal, int IsSigned ) ;
FUNCTION: int LLVMCreateExecutionEngine
( LLVMExecutionEngineRef *OutEE, LLVMModuleProviderRef MP, char** OutError ) ;
FUNCTION: int LLVMCreateJITCompiler
( LLVMExecutionEngineRef* OutJIT, LLVMModuleProviderRef MP, unsigned OptLevel, char** OutError ) ;
FUNCTION: void LLVMDisposeExecutionEngine ( LLVMExecutionEngineRef EE ) ;
FUNCTION: void LLVMFreeMachineCodeForFunction ( LLVMExecutionEngineRef EE, LLVMValueRef F ) ;
FUNCTION: void LLVMAddModuleProvider ( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP ) ;
FUNCTION: int LLVMRemoveModuleProvider
( LLVMExecutionEngineRef EE, LLVMModuleProviderRef MP, LLVMModuleRef* OutMod, char** OutError ) ;
FUNCTION: int LLVMFindFunction
( LLVMExecutionEngineRef EE, char* Name, LLVMValueRef* OutFn ) ;
FUNCTION: void* LLVMGetPointerToGlobal ( LLVMExecutionEngineRef EE, LLVMValueRef Global ) ;
FUNCTION: LLVMGenericValueRef LLVMRunFunction
( LLVMExecutionEngineRef EE, LLVMValueRef F, unsigned NumArgs, LLVMGenericValueRef* Args ) ;

View File

@ -0,0 +1,7 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.llvm io.pathnames llvm.invoker llvm.reader tools.test ;
[ 3 ] [
<< "resource:extra/llvm/reader/add.bc" install-bc >> 1 2 add
] unit-test

View File

@ -0,0 +1,56 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien arrays assocs compiler.units effects
io.backend io.pathnames kernel llvm.core llvm.jit llvm.reader
llvm.types make namespaces sequences specialized-arrays.alien
vocabs words ;
IN: llvm.invoker
! get function name, ret type, param types and names
! load module
! iterate through functions in a module
TUPLE: function name alien return params ;
: params ( llvm-function -- param-list )
dup LLVMCountParams <void*-array>
[ LLVMGetParams ] keep >array
[ [ LLVMGetValueName ] [ LLVMTypeOf tref> ] bi 2array ] map ;
: <function> ( LLVMValueRef -- function )
function new
over LLVMGetValueName >>name
over LLVMTypeOf tref> type>> return>> >>return
swap params >>params ;
: (functions) ( llvm-function -- )
[ dup , LLVMGetNextFunction (functions) ] when* ;
: functions ( llvm-module -- functions )
LLVMGetFirstFunction [ (functions) ] { } make [ <function> ] map ;
: function-effect ( function -- effect )
[ params>> [ first ] map ] [ return>> void? 0 1 ? ] bi <effect> ;
: install-function ( function -- )
dup name>> "alien.llvm" create-vocab drop
"alien.llvm" create swap
[
dup name>> function-pointer ,
dup return>> c-type ,
dup params>> [ second c-type ] map ,
"cdecl" , \ alien-indirect ,
] [ ] make swap function-effect [ define-declared ] with-compilation-unit ;
: install-module ( name -- )
thejit get mps>> at [
module>> functions [ install-function ] each
] [ "no such module" throw ] if* ;
: install-bc ( path -- )
[ normalize-path ] [ file-name ] bi
[ load-into-jit ] keep install-module ;
<< "alien.llvm" create-vocab drop >>

View File

@ -0,0 +1,5 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: destructors llvm.jit llvm.wrappers tools.test ;
[ ] [ "test" <module> "test" add-module "test" remove-module ] unit-test

49
extra/llvm/jit/jit.factor Normal file
View File

@ -0,0 +1,49 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax assocs destructors
kernel llvm.core llvm.engine llvm.wrappers namespaces ;
IN: llvm.jit
SYMBOL: thejit
TUPLE: jit ee mps ;
: empty-engine ( -- engine )
"initial-module" <module> <provider> <engine> ;
: <jit> ( -- jit )
jit new empty-engine >>ee H{ } clone >>mps ;
: (remove-functions) ( function -- )
thejit get ee>> value>> over LLVMFreeMachineCodeForFunction
LLVMGetNextFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
: remove-functions ( module -- )
! free machine code for each function in module
LLVMGetFirstFunction dup ALIEN: 0 = [ drop ] [ (remove-functions) ] if ;
: remove-provider ( provider -- )
thejit get ee>> value>> swap value>> f <void*> f <void*>
[ LLVMRemoveModuleProvider drop ] 2keep *void* [ llvm-throw ] when*
*void* module new swap >>value
[ value>> remove-functions ] with-disposal ;
: remove-module ( name -- )
dup thejit get mps>> at [
remove-provider
thejit get mps>> delete-at
] [ drop ] if* ;
: add-module ( module name -- )
[ <provider> ] dip [ remove-module ] keep
thejit get ee>> value>> pick
[ [ value>> LLVMAddModuleProvider ] [ t >>disposed drop ] bi ] with-disposal
thejit get mps>> set-at ;
: function-pointer ( name -- alien )
thejit get ee>> value>> dup
rot f <void*> [ LLVMFindFunction drop ] keep
*void* LLVMGetPointerToGlobal ;
thejit [ <jit> ] initialize

BIN
extra/llvm/reader/add.bc Normal file

Binary file not shown.

5
extra/llvm/reader/add.ll Normal file
View File

@ -0,0 +1,5 @@
define i32 @add(i32 %x, i32 %y) {
entry:
%sum = add i32 %x, %y
ret i32 %sum
}

View File

@ -0,0 +1,20 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.syntax destructors kernel
llvm.core llvm.engine llvm.jit llvm.wrappers ;
IN: llvm.reader
: buffer>module ( buffer -- module )
[
value>> f <void*> f <void*>
[ LLVMParseBitcode drop ] 2keep
*void* [ llvm-throw ] when* *void*
module new swap >>value
] with-disposal ;
: load-module ( path -- module )
<buffer> buffer>module ;
: load-into-jit ( path name -- )
[ load-module ] dip add-module ;

1
extra/llvm/tags.txt Normal file
View File

@ -0,0 +1 @@
bindings

View File

@ -0,0 +1,40 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel llvm.types sequences tools.test ;
[ T{ integer f 32 } ] [ " i32 " parse-type ] unit-test
[ float ] [ " float " parse-type ] unit-test
[ T{ pointer f f x86_fp80 } ] [ " x86_fp80 * " parse-type ] unit-test
[ T{ vector f f 4 T{ integer f 32 } } ] [ " < 4 x i32 > " parse-type ] unit-test
[ T{ struct f f { float double } f } ] [ TYPE: { float , double } ; ] unit-test
[ T{ array f f 0 float } ] [ TYPE: [ 0 x float ] ; ] unit-test
[ label void metadata ]
[ [ " label " " void " " metadata " ] [ parse-type ] each ] unit-test
[ T{ function f f float { float float } t } ]
[ TYPE: float ( float , float , ... ) ; ] unit-test
[ T{ struct f f { float TYPE: i32 (i32)* ; } t } ]
[ TYPE: < { float, i32 (i32)* } > ; ] unit-test
[ t ] [ TYPE: i32 ; TYPE: i32 ; [ >tref ] bi@ = ] unit-test
[ t ] [ TYPE: i32 * ; TYPE: i32 * ; [ >tref ] bi@ = ] unit-test
[ TYPE: i32 ; ] [ TYPE: i32 ; >tref tref> ] unit-test
[ TYPE: float ; ] [ TYPE: float ; >tref tref> ] unit-test
[ TYPE: double ; ] [ TYPE: double ; >tref tref> ] unit-test
[ TYPE: x86_fp80 ; ] [ TYPE: x86_fp80 ; >tref tref> ] unit-test
[ TYPE: fp128 ; ] [ TYPE: fp128 ; >tref tref> ] unit-test
[ TYPE: ppc_fp128 ; ] [ TYPE: ppc_fp128 ; >tref tref> ] unit-test
[ TYPE: opaque ; ] [ TYPE: opaque ; >tref tref> ] unit-test
[ TYPE: label ; ] [ TYPE: label ; >tref tref> ] unit-test
[ TYPE: void ; ] [ TYPE: void ; >tref tref> ] unit-test
[ TYPE: i32* ; ] [ TYPE: i32* ; >tref tref> ] unit-test
[ TYPE: < 2 x i32 > ; ] [ TYPE: < 2 x i32 > ; >tref tref> ] unit-test
[ TYPE: [ 0 x i32 ] ; ] [ TYPE: [ 0 x i32 ] ; >tref tref> ] unit-test
[ TYPE: { i32, i32 } ; ] [ TYPE: { i32, i32 } ; >tref tref> ] unit-test
[ TYPE: < { i32, i32 } > ; ] [ TYPE: < { i32, i32 } > ; >tref tref> ] unit-test
[ TYPE: i32 ( i32 ) ; ] [ TYPE: i32 ( i32 ) ; >tref tref> ] unit-test
[ TYPE: \1* ; ] [ TYPE: \1* ; >tref tref> ] unit-test
[ TYPE: { i32, \2* } ; ] [ TYPE: { i32, \2* } ; >tref tref> ] unit-test

View File

@ -0,0 +1,246 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays combinators kernel llvm.core
locals math.parser math multiline
namespaces parser peg.ebnf sequences
sequences.deep specialized-arrays.alien strings vocabs words ;
IN: llvm.types
! Type resolution strategy:
! pass 1:
! create the type with uprefs mapped to opaque types
! cache typerefs in enclosing types for pass 2
! if our type is concrete, then we are done
!
! pass 2:
! wrap our abstract type in a type handle
! create a second type, using the cached enclosing type info
! resolve the first type to the second
!
GENERIC: (>tref) ( type -- LLVMTypeRef )
GENERIC: ((tref>)) ( LLVMTypeRef type -- type )
GENERIC: c-type ( type -- str )
! default implementation for simple types
M: object ((tref>)) nip ;
: unsupported-type ( -- )
"cannot generate c-type: unsupported llvm type" throw ;
M: object c-type unsupported-type ;
TUPLE: integer size ;
C: <integer> integer
M: integer (>tref) size>> LLVMIntType ;
M: integer ((tref>)) swap LLVMGetIntTypeWidth >>size ;
M: integer c-type size>> {
{ 64 [ "longlong" ] }
{ 32 [ "int" ] }
{ 16 [ "short" ] }
{ 8 [ "char" ] }
[ unsupported-type ]
} case ;
SINGLETONS: float double x86_fp80 fp128 ppc_fp128 ;
M: float (>tref) drop LLVMFloatType ;
M: double (>tref) drop LLVMDoubleType ;
M: double c-type drop "double" ;
M: x86_fp80 (>tref) drop LLVMX86FP80Type ;
M: fp128 (>tref) drop LLVMFP128Type ;
M: ppc_fp128 (>tref) drop LLVMPPCFP128Type ;
SINGLETONS: opaque label void metadata ;
M: opaque (>tref) drop LLVMOpaqueType ;
M: label (>tref) drop LLVMLabelType ;
M: void (>tref) drop LLVMVoidType ;
M: void c-type drop "void" ;
M: metadata (>tref) drop
"metadata types unsupported by llvm c bindings" throw ;
! enclosing types cache their llvm refs during
! the first pass, used in the second pass to
! resolve uprefs
TUPLE: enclosing cached ;
GENERIC: clean ( type -- )
GENERIC: clean* ( type -- )
M: object clean drop ;
M: enclosing clean f >>cached clean* ;
! builds the stack of types that uprefs need to refer to
SYMBOL: types
:: push-type ( type quot: ( type -- LLVMTypeRef ) -- LLVMTypeRef )
type types get push
type quot call( type -- LLVMTypeRef )
types get pop over >>cached drop ;
DEFER: <up-ref>
:: push-ref ( ref quot: ( LLVMTypeRef -- type ) -- type )
ref types get index
[ types get length swap - <up-ref> ] [
ref types get push
ref quot call( LLVMTypeRef -- type )
types get pop drop
] if* ;
GENERIC: (>tref)* ( type -- LLVMTypeRef )
M: enclosing (>tref) [ (>tref)* ] push-type ;
DEFER: type-kind
GENERIC: (tref>)* ( LLVMTypeRef type -- type )
M: enclosing ((tref>)) [ (tref>)* ] curry push-ref ;
: (tref>) ( LLVMTypeRef -- type ) dup type-kind ((tref>)) ;
TUPLE: pointer < enclosing type ;
: <pointer> ( t -- o ) pointer new swap >>type ;
M: pointer (>tref)* type>> (>tref) 0 LLVMPointerType ;
M: pointer clean* type>> clean ;
M: pointer (tref>)* swap LLVMGetElementType (tref>) >>type ;
M: pointer c-type type>> 8 <integer> = "char*" "void*" ? ;
TUPLE: vector < enclosing size type ;
: <vector> ( s t -- o )
vector new
swap >>type swap >>size ;
M: vector (>tref)* [ type>> (>tref) ] [ size>> ] bi LLVMVectorType ;
M: vector clean* type>> clean ;
M: vector (tref>)*
over LLVMGetElementType (tref>) >>type
swap LLVMGetVectorSize >>size ;
TUPLE: struct < enclosing types packed? ;
: <struct> ( ts p? -- o )
struct new
swap >>packed? swap >>types ;
M: struct (>tref)*
[ types>> [ (>tref) ] map >void*-array ]
[ types>> length ]
[ packed?>> 1 0 ? ] tri LLVMStructType ;
M: struct clean* types>> [ clean ] each ;
M: struct (tref>)*
over LLVMIsPackedStruct 0 = not >>packed?
swap dup LLVMCountStructElementTypes <void*-array>
[ LLVMGetStructElementTypes ] keep >array
[ (tref>) ] map >>types ;
TUPLE: array < enclosing size type ;
: <array> ( s t -- o )
array new
swap >>type swap >>size ;
M: array (>tref)* [ type>> (>tref) ] [ size>> ] bi LLVMArrayType ;
M: array clean* type>> clean ;
M: array (tref>)*
over LLVMGetElementType (tref>) >>type
swap LLVMGetArrayLength >>size ;
SYMBOL: ...
TUPLE: function < enclosing return params vararg? ;
: <function> ( ret params var? -- o )
function new
swap >>vararg? swap >>params swap >>return ;
M: function (>tref)* {
[ return>> (>tref) ]
[ params>> [ (>tref) ] map >void*-array ]
[ params>> length ]
[ vararg?>> 1 0 ? ]
} cleave LLVMFunctionType ;
M: function clean* [ return>> clean ] [ params>> [ clean ] each ] bi ;
M: function (tref>)*
over LLVMIsFunctionVarArg 0 = not >>vararg?
over LLVMGetReturnType (tref>) >>return
swap dup LLVMCountParamTypes <void*-array>
[ LLVMGetParamTypes ] keep >array
[ (tref>) ] map >>params ;
: type-kind ( LLVMTypeRef -- class )
LLVMGetTypeKind {
{ LLVMVoidTypeKind [ void ] }
{ LLVMFloatTypeKind [ float ] }
{ LLVMDoubleTypeKind [ double ] }
{ LLVMX86_FP80TypeKind [ x86_fp80 ] }
{ LLVMFP128TypeKind [ fp128 ] }
{ LLVMPPC_FP128TypeKind [ ppc_fp128 ] }
{ LLVMLabelTypeKind [ label ] }
{ LLVMIntegerTypeKind [ integer new ] }
{ LLVMFunctionTypeKind [ function new ] }
{ LLVMStructTypeKind [ struct new ] }
{ LLVMArrayTypeKind [ array new ] }
{ LLVMPointerTypeKind [ pointer new ] }
{ LLVMOpaqueTypeKind [ opaque ] }
{ LLVMVectorTypeKind [ vector new ] }
} case ;
TUPLE: up-ref height ;
C: <up-ref> up-ref
M: up-ref (>tref)
types get length swap height>> - types get nth
cached>> [ LLVMOpaqueType ] unless* ;
: resolve-types ( typeref typeref -- typeref )
over LLVMCreateTypeHandle [ LLVMRefineType ] dip
[ LLVMResolveTypeHandle ] keep LLVMDisposeTypeHandle ;
: >tref-caching ( type -- LLVMTypeRef )
V{ } clone types [ (>tref) ] with-variable ;
: >tref ( type -- LLVMTypeRef )
[ >tref-caching ] [ >tref-caching ] [ clean ] tri
2dup = [ drop ] [ resolve-types ] if ;
: tref> ( LLVMTypeRef -- type )
V{ } clone types [ (tref>) ] with-variable ;
: t. ( type -- )
>tref
"type-info" LLVMModuleCreateWithName
[ "t" rot LLVMAddTypeName drop ]
[ LLVMDumpModule ]
[ LLVMDisposeModule ] tri ;
EBNF: parse-type
WhiteSpace = " "*
Zero = "0" => [[ drop 0 ]]
LeadingDigit = [1-9]
DecimalDigit = [0-9]
Number = LeadingDigit:d (DecimalDigit)*:ds => [[ ds d prefix string>number ]]
WhiteNumberSpace = WhiteSpace Number:n WhiteSpace => [[ n ]]
WhiteZeroSpace = WhiteSpace (Zero | Number):n WhiteSpace => [[ n ]]
Integer = "i" Number:n => [[ n <integer> ]]
FloatingPoint = ( "float" | "double" | "x86_fp80" | "fp128" | "ppc_fp128" ) => [[ "llvm.types" vocab lookup ]]
LabelVoidMetadata = ( "label" | "void" | "metadata" | "opaque" ) => [[ "llvm.types" vocab lookup ]]
Primitive = LabelVoidMetadata | FloatingPoint
Pointer = T:t WhiteSpace "*" => [[ t <pointer> ]]
Vector = "<" WhiteNumberSpace:n "x" Type:t ">" => [[ n t <vector> ]]
StructureTypesList = "," Type:t => [[ t ]]
Structure = "{" Type:t (StructureTypesList)*:ts "}" => [[ ts t prefix >array f <struct> ]]
Array = "[" WhiteZeroSpace:n "x" Type:t "]" => [[ n t <array> ]]
NoFunctionParams = "(" WhiteSpace ")" => [[ drop { } ]]
VarArgs = WhiteSpace "..." WhiteSpace => [[ drop ... ]]
ParamListContinued = "," (Type | VarArgs):t => [[ t ]]
ParamList = "(" Type:t (ParamListContinued*):ts ")" => [[ ts t prefix ]]
Function = T:t WhiteSpace ( ParamList | NoFunctionParams ):ts => [[ ... ts member? dup [ ... ts delete ] when t ts >array rot <function> ]]
PackedStructure = "<" WhiteSpace "{" Type:ty (StructureTypesList)*:ts "}" WhiteSpace ">" => [[ ts ty prefix >array t <struct> ]]
UpReference = "\\" Number:n => [[ n <up-ref> ]]
Name = '%' ([a-zA-Z][a-zA-Z0-9]*):id => [[ id flatten >string ]]
T = Pointer | Function | Primitive | Integer | Vector | Structure | PackedStructure | Array | UpReference | Name
Type = WhiteSpace T:t WhiteSpace => [[ t ]]
Program = Type
;EBNF
SYNTAX: TYPE: ";" parse-multiline-string parse-type parsed ;

View File

@ -0,0 +1,7 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: destructors kernel llvm.wrappers sequences tools.test vocabs ;
[ ] [ "test" <module> dispose ] unit-test
[ ] [ "test" <module> <provider> dispose ] unit-test
[ ] [ "llvm.jit" vocabs member? [ "test" <module> <provider> <engine> dispose ] unless ] unit-test

View File

@ -0,0 +1,62 @@
! Copyright (C) 2009 Matthew Willis.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien.c-types alien.strings
io.encodings.utf8 destructors kernel
llvm.core llvm.engine ;
IN: llvm.wrappers
: llvm-throw ( char* -- )
[ utf8 alien>string ] [ LLVMDisposeMessage ] bi throw ;
: <dispose> ( alien class -- disposable ) new swap >>value ;
TUPLE: module value disposed ;
M: module dispose* value>> LLVMDisposeModule ;
: <module> ( name -- module )
LLVMModuleCreateWithName module <dispose> ;
TUPLE: provider value module disposed ;
M: provider dispose* value>> LLVMDisposeModuleProvider ;
: (provider) ( module -- provider )
[ value>> LLVMCreateModuleProviderForExistingModule provider <dispose> ]
[ t >>disposed value>> ] bi
>>module ;
: <provider> ( module -- provider )
[ (provider) ] with-disposal ;
TUPLE: engine value disposed ;
M: engine dispose* value>> LLVMDisposeExecutionEngine ;
: (engine) ( provider -- engine )
[
value>> f <void*> f <void*>
[ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep
*void* [ llvm-throw ] when* *void*
]
[ t >>disposed drop ] bi
engine <dispose> ;
: <engine> ( provider -- engine )
[ (engine) ] with-disposal ;
: (add-block) ( name -- basic-block )
"function" swap LLVMAppendBasicBlock ;
TUPLE: builder value disposed ;
M: builder dispose* value>> LLVMDisposeBuilder ;
: <builder> ( name -- builder )
(add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep
builder <dispose> ;
TUPLE: buffer value disposed ;
M: buffer dispose* value>> LLVMDisposeMemoryBuffer ;
: <buffer> ( path -- module )
f <void*> f <void*>
[ LLVMCreateMemoryBufferWithContentsOfFile drop ] 2keep
*void* [ llvm-throw ] when* *void* buffer <dispose> ;