Merge branch 'master' of git://factorcode.org/git/factor into llvm

diff --git a/extra/central/authors.txt b/extra/central/authors.txt
new file mode 100644 (file)
index 0000000..5645cd9
--- /dev/null
+++ b/extra/central/authors.txt
@@ -0,0 +1 @@
+Matthew Willis

diff --git a/extra/central/central-docs.factor b/extra/central/central-docs.factor
new file mode 100644 (file)
index 0000000..458f528
--- /dev/null
+++ b/extra/central/central-docs.factor
@@ -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 } "."
+} ;
\ No newline at end of file

diff --git a/extra/central/central-tests.factor b/extra/central/central-tests.factor
new file mode 100644 (file)
index 0000000..3dbcbf3
--- /dev/null
+++ b/extra/central/central-tests.factor
@@ -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
\ No newline at end of file

diff --git a/extra/central/central.factor b/extra/central/central.factor
new file mode 100644 (file)
index 0000000..f717514
--- /dev/null
+++ b/extra/central/central.factor
@@ -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 ;
\ No newline at end of file

diff --git a/extra/central/tags.txt b/extra/central/tags.txt
new file mode 100644 (file)
index 0000000..f427429
--- /dev/null
+++ b/extra/central/tags.txt
@@ -0,0 +1 @@
+extensions

diff --git a/extra/llvm/authors.txt b/extra/llvm/authors.txt
new file mode 100644 (file)
index 0000000..5645cd9
--- /dev/null
+++ b/extra/llvm/authors.txt
@@ -0,0 +1 @@
+Matthew Willis

diff --git a/extra/llvm/bindings/bindings-tests.factor b/extra/llvm/bindings/bindings-tests.factor
new file mode 100644 (file)
index 0000000..59eaf27
--- /dev/null
+++ b/extra/llvm/bindings/bindings-tests.factor
@@ -0,0 +1,32 @@
+USING: accessors alien compiler.units kernel
+llvm.bindings llvm.core tools.test words ;
+
+IN: scratchpad
+
+: add-abi ( x y -- x+y ) ! to be filled in by llvm
+    drop ;
+
+: llvm-add ( x y -- x+y )
+    "test" <module> [
+        {
+            { [ 32 LLVMIntType ] "add" }
+            { [ 32 LLVMIntType ] "x" }
+            { [ 32 LLVMIntType ] "y" }
+        } <function> [
+            "entry" <builder> [
+                builder value>> "x" get-param "y" get-param "sum" LLVMBuildAdd
+                builder value>> swap LLVMBuildRet drop
+            ] with-builder
+        ] with-function
+        
+        <engine>
+    ] with-module
+    
+    [
+        "add" find-function global>pointer
+        [ "int" { "int" "int" } "cdecl" alien-indirect ] curry \ add-abi swap
+        (( x y -- x+y )) [ define-declared ] with-compilation-unit
+        add-abi ! call our new word
+    ] with-engine ; inline
+
+[ 7 ] [ 3 4 llvm-add ] unit-test
\ No newline at end of file

diff --git a/extra/llvm/bindings/bindings.factor b/extra/llvm/bindings/bindings.factor
new file mode 100644 (file)
index 0000000..390b55a
--- /dev/null
+++ b/extra/llvm/bindings/bindings.factor
@@ -0,0 +1,79 @@
+USING: accessors alien.c-types alien.strings arrays
+central destructors kernel llvm.core llvm.engine
+quotations sequences specialized-arrays.alien ;
+
+IN: llvm.bindings
+
+: llvm-throw ( char** -- )
+    [ alien>string ] [ LLVMDisposeMessage ] bi throw ;
+
+DISPOSABLE-CENTRAL: module
+CENTRAL: function
+DISPOSABLE-CENTRAL: builder
+DISPOSABLE-CENTRAL: engine
+
+: <dispose> ( alien class -- disposable ) new swap >>value ;
+
+TUPLE: LLVMModule value disposed ;
+M: LLVMModule dispose* value>> LLVMDisposeModule ;
+
+: <module> ( name -- module )
+    LLVMModuleCreateWithName LLVMModule <dispose> ;
+
+TUPLE: LLVMModuleProvider value disposed ;
+M: LLVMModuleProvider dispose* value>> LLVMDisposeModuleProvider ;
+
+: <provider> ( -- module-provider )
+    module t >>disposed value>> LLVMCreateModuleProviderForExistingModule
+    LLVMModuleProvider <dispose> ;
+
+: (add-block) ( name -- basic-block )
+    function swap LLVMAppendBasicBlock ;
+
+TUPLE: LLVMBuilder value disposed ;
+M: LLVMBuilder dispose* value>> LLVMDisposeBuilder ;
+
+: <builder> ( name -- builder )
+    (add-block) LLVMCreateBuilder [ swap LLVMPositionBuilderAtEnd ] keep
+    LLVMBuilder <dispose> ;
+
+TUPLE: LLVMExecutionEngine value disposed ;
+M: LLVMExecutionEngine dispose* value>> LLVMDisposeExecutionEngine ;
+
+: <engine> ( -- engine )
+    <provider> [
+        dup value>> f <void*> f <void*>
+        [ swapd 0 swap LLVMCreateJITCompiler drop ] 2keep
+        *void* [ llvm-throw ] when* *void* LLVMExecutionEngine <dispose>
+        swap t >>disposed drop
+    ] with-disposal ;
+
+: resolve-type ( callable/alien -- type )
+    dup callable? [ call( -- type ) ] when ;
+
+: <function-type> ( args -- type )
+    [ resolve-type ] map
+    unclip swap [ >void*-array ] keep length 0 LLVMFunctionType ;
+
+: >>cc ( function calling-convention -- function )
+    dupd LLVMSetFunctionCallConv ;
+
+: params>> ( function -- array )
+    dup LLVMCountParams "LLVMValueRef" <c-array> [ LLVMGetParams ] keep
+    byte-array>void*-array >array ;
+
+: get-param ( name -- value )
+    function params>> swap [ swap LLVMGetValueName = ] curry find nip ;
+
+: set-param-names ( names function -- )
+    params>> swap [ LLVMSetValueName ] 2each ;
+
+: <function> ( args -- function )
+    module value>> over first second pick
+    [ first ] map <function-type> LLVMAddFunction LLVMCCallConv >>cc tuck
+    [ rest [ second ] map ] dip set-param-names ;
+
+: global>pointer ( value -- alien ) engine value>> swap LLVMGetPointerToGlobal ;
+
+: find-function ( name -- fn )
+    engine value>> swap f <void*> [ LLVMFindFunction drop ] keep *void* ;
\ No newline at end of file

diff --git a/extra/llvm/core/core.factor b/extra/llvm/core/core.factor
new file mode 100644 (file)
index 0000000..7b0f18b
--- /dev/null
+++ b/extra/llvm/core/core.factor
@@ -0,0 +1,392 @@
+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
+
+>>
+
+! 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
+  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
+
+! 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: 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 ) ;

diff --git a/extra/llvm/engine/engine.factor b/extra/llvm/engine/engine.factor
new file mode 100644 (file)
index 0000000..db5c701
--- /dev/null
+++ b/extra/llvm/engine/engine.factor
@@ -0,0 +1,59 @@
+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: 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 ) ;
\ No newline at end of file

diff --git a/extra/llvm/tags.txt b/extra/llvm/tags.txt
new file mode 100644 (file)
index 0000000..bb863cf
--- /dev/null
+++ b/extra/llvm/tags.txt
@@ -0,0 +1 @@
+bindings

diff --git a/extra/llvm/types/types-tests.factor b/extra/llvm/types/types-tests.factor
new file mode 100644 (file)
index 0000000..8e9b9e2
--- /dev/null
+++ b/extra/llvm/types/types-tests.factor
@@ -0,0 +1,20 @@
+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
\ No newline at end of file

diff --git a/extra/llvm/types/types.factor b/extra/llvm/types/types.factor
new file mode 100644 (file)
index 0000000..91210af
--- /dev/null
+++ b/extra/llvm/types/types.factor
@@ -0,0 +1,172 @@
+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: llvm> ( LLVMTypeRef -- type )
+
+TUPLE: integer size ;
+C: <integer> integer
+
+M: integer (>tref) size>> LLVMIntType ;
+
+SINGLETONS: float double x86_fp80 fp128 ppc_fp128 ;
+
+M: float (>tref) drop LLVMFloatType ;
+M: double (>tref) drop LLVMDoubleType ;
+M: x86_fp80 (>tref) drop LLVMX86FP80Type ;
+M: fp128 (>tref) drop LLVMFP128Type ;
+M: ppc_fp128 (>tref) drop LLVMPPCFP128Type ;
+
+SINGLETONS: label void metadata ;
+
+M: label (>tref) drop LLVMLabelType ;
+M: void (>tref) drop LLVMVoidType ;
+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 ;
+
+GENERIC: (>tref)* ( type -- LLVMTypeRef )
+M: enclosing (>tref) [ (>tref)* ] push-type ;
+
+TUPLE: pointer < enclosing type ;
+: <pointer> ( t -- o ) pointer new swap >>type ;
+
+M: pointer (>tref)* type>> (>tref) 0 LLVMPointerType ;
+M: pointer clean* type>> clean ;
+
+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 ;
+
+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 ;
+
+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 ;
+
+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 ;
+
+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 ;
+
+: 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" ) => [[ "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 ; 
\ No newline at end of file