VSL - The compiler.llvm.core Structure
# Copyright 2011 Petter Urkedal
#
# This file is part of the Viz Standard Library <http://www.vizlang.org/>.
#
# The Viz Standard Library (VSL) is free software: you can redistribute it
# and/or modify it under the terms of the GNU Lesser General Public License as
# published by the Free Software Foundation, either version 3 of the License,
# or (at your option) any later version.
#
# The VSL is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for
# more details.
#
# You should have received a copy of the GNU Lesser General Public License
# along with the VSL. If not, see <http://www.gnu.org/licenses/>.
open:c "llvm-c/Core.h"
open:c "compiler/llvm_suppl.h"
open pervasive
open effect
open foreign.cabi.memory
# Z. LLVM Core API
# Z.Z. Auxiliary Types
in iorder
type t := int
val:c EQ : t := "LLVMIntEQ"
val:c NE : t := "LLVMIntNE"
val:c UGT : t := "LLVMIntUGT"
val:c UGE : t := "LLVMIntUGE"
val:c ULT : t := "LLVMIntULT"
val:c ULE : t := "LLVMIntULE"
val:c SGT : t := "LLVMIntSGT"
val:c SGE : t := "LLVMIntSGE"
val:c SLT : t := "LLVMIntSLT"
val:c SLE : t := "LLVMIntSLE"
type iorder := iorder.t
in forder
type t
inj:c FALSE : t := "LLVMRealPredicateFalse"
inj:c OEQ : t := "LLVMRealOEQ"
inj:c OGT : t := "LLVMRealOGT"
inj:c OGE : t := "LLVMRealOGE"
inj:c OLT : t := "LLVMRealOLT"
inj:c OLE : t := "LLVMRealOLE"
inj:c ONE : t := "LLVMRealONE"
inj:c ORD : t := "LLVMRealORD"
inj:c UNO : t := "LLVMRealUNO"
inj:c UEQ : t := "LLVMRealUEQ"
inj:c UGT : t := "LLVMRealUGT"
inj:c UGE : t := "LLVMRealUGE"
inj:c ULT : t := "LLVMRealULT"
inj:c ULE : t := "LLVMRealULE"
inj:c UNE : t := "LLVMRealUNE"
inj:c TRUE : t := "LLVMRealPredicateTrue"
type forder := forder.t
# Z.Z. Contexts
type:c context φ := "LLVMContextRef"
val:c create_context : φ /~ context φ := "LLVMContextCreate"
val:c global_context : world /~ context world := "LLVMGetGlobalContext"
val:cf dispose_context : context φ → φ /~ unit := "LLVMContextDispose"
# Z.Z. Modules
type:c module φ := "LLVMModuleRef"
val create_module : context φ → string → φ /~ module φ
val:cf dispose_module : module φ → φ /~ unit := "LLVMDisposeModule"
val:c get_data_layout : module φ → φ /~ string := "LLVMGetDataLayout"
val:c set_data_layout : module φ → string → φ /~ unit := "LLVMSetDataLayout"
val:c get_target : module φ → φ /~ string := "LLVMGetTarget"
val:c set_target : module φ → string → φ /~ unit := "LLVMSetTarget"
val:c dump_module : module φ → φ /~ unit := "LLVMDumpModule"
val:c set_module_inline_asm : module φ → string → φ /~ unit
:= "LLVMSetModuleInlineAsm"
val:c _create_module : string → context φ → φ /~ module φ
:= "LLVMModuleCreateWithNameInContext"
let create_module ctx name be _create_module name ctx
val:c assert_valid_module : module φ → φ /~ unit := "LLVMAssertValidModule"
# Z.Z. Types
type lkind
inj:c lkind_void := "LLVMVoidTypeKind"
inj:c lkind_half := "LLVMHalfTypeKind"
inj:c lkind_float := "LLVMFloatTypeKind"
inj:c lkind_double := "LLVMDoubleTypeKind"
inj:c lkind_x86_fp80 := "LLVMX86_FP80TypeKind"
inj:c lkind_fp128 := "LLVMFP128TypeKind"
inj:c lkind_ppc_fp128 := "LLVMPPC_FP128TypeKind"
inj:c lkind_label := "LLVMLabelTypeKind"
inj:c lkind_integer := "LLVMIntegerTypeKind"
inj:c lkind_function := "LLVMFunctionTypeKind"
inj:c lkind_struct := "LLVMStructTypeKind"
inj:c lkind_array := "LLVMArrayTypeKind"
inj:c lkind_pointer := "LLVMPointerTypeKind"
inj:c lkind_vector := "LLVMVectorTypeKind"
inj:c lkind_metadata := "LLVMMetadataTypeKind"
inj:c lkind_mmx := "LLVMX86_MMXTypeKind"
type:c ltype φ := "LLVMTypeRef"
val:c type_kind : ltype φ → lkind#e := "LLVMGetTypeKind"
val:c type_context : ltype φ → context φ := "LLVMGetTypeContext"
val:c int1_type : context φ → ltype φ := "LLVMInt1TypeInContext"
val:c int8_type : context φ → ltype φ := "LLVMInt8TypeInContext"
val:c int16_type : context φ → ltype φ := "LLVMInt16TypeInContext"
val:c int32_type : context φ → ltype φ := "LLVMInt32TypeInContext"
val:c int64_type : context φ → ltype φ := "LLVMInt64TypeInContext"
val:c int_type : context φ → int → ltype φ := "LLVMIntTypeInContext"
val:c float_type : context φ → ltype φ := "LLVMFloatTypeInContext"
val:c double_type : context φ → ltype φ := "LLVMDoubleTypeInContext"
val:c x86_fp80_type : context φ → ltype φ := "LLVMX86FP80TypeInContext"
val:c fp128_type : context φ → ltype φ := "LLVMFP128TypeInContext"
val:c ppc_fp128_type : context φ → ltype φ := "LLVMPPCFP128TypeInContext"
# Z.Z. Values
type:c value φ := "LLVMValueRef"
type:c memorybuffer φ := "LLVMMemoryBufferRef"
# Z.Z.Z. Operations on Values
val:c type_of : value φ → φ /~ ltype φ := "LLVMTypeOf"
val:c get_value_name : value φ → φ /~ string := "LLVMGetValueName"
val:c set_value_name : value φ → string → φ /~ unit := "LLVMSetValueName"
val:c dump_value : value φ → φ /~ unit := "LLVMDumpValue"
# Z.Z.Z. Operations on Uses
# Z.Z.Z. Operations on Users
# Z.Z.Z. Operations on Constants of any Type
# Z.Z.Z. Operations on Metadata
# Z.Z.Z. Operations on Scalar Constants
val const_int : ltype φ → int → φ /~ value φ
val const_int_of_int64 : ltype φ → int64 → φ /~ value φ
val:c const_int_of_string : ltype φ → string → int → φ /~ value φ
:= "LLVMConstIntOfString"
val:c const_float : ltype φ → float → φ /~ value φ := "LLVMConstReal"
val:c const_float_of_string : ltype φ → string → φ /~ value φ
:= "LLVMConstRealOfString"
val:c _const_int : ltype φ → int → bool → φ /~ value φ := "LLVMConstInt"
let const_int t x be _const_int t x true
val:c _const_int64 : ltype φ → int64 → bool → φ /~ value φ := "LLVMConstInt"
let const_int_of_int64 t x be _const_int64 t x true
# Z.Z.Z. Operations on Composite Constants
# Z.Z.Z. Constant Expressions
# Z.Z.Z. Operations on Global Variables, Functions, and Aliases
# Z.Z.Z. Operations on Global Variables
# Z.Z.Z. Operations on Aliases
# Z.Z.Z. Operations on Functions
type callconv := int
val:c callconv_c : int := "LLVMCCallConv"
val:c callconv_fast : int := "LLVMFastCallConv"
val:c callconv_cold : int := "LLVMColdCallConv"
val:c callconv_x86_std : int := "LLVMX86StdcallCallConv"
val:c callconv_x86_fast : int := "LLVMX86FastcallCallConv"
val:c add_function : module φ → string → ltype φ → φ /~ value φ
:= "LLVMAddFunction"
val:c get_named_function : module φ → string → φ /~ option (value φ)
:= "LLVMGetNamedFunction"
val:c get_first_function : module φ → φ /~ option (value φ)
:= "LLVMGetFirstFunction"
val:c get_last_function : module φ → φ /~ option (value φ)
:= "LLVMGetLastFunction"
val:c get_next_function : value φ → φ /~ option (value φ)
:= "LLVMGetNextFunction"
val:c get_prev_function : value φ → φ /~ option (value φ)
:= "LLVMGetPreviousFunction"
val:c delete_function : value φ → φ /~ unit
:= "LLVMDeleteFunction"
val:c get_function_callconv : value φ → φ /~ int
:= "LLVMGetFunctionCallConv"
val:c set_function_callconv : value φ → int → φ /~ unit
:= "LLVMSetFunctionCallConv"
val:c get_function_gc : value φ → φ /~ option string := "LLVMGetGC"
val:c set_function_gc : value φ → string → φ /~ unit := "LLVMSetGC"
val function_type : ltype φ → array (ltype φ) → ltype φ
val:c _function_type : ltype φ → ptr φ → int → bool → ltype φ
:= "LLVMFunctionType"
let function_type rt ats be unsafe_observe what!
let cta do foreign.cabi.utils.malloc_ptrarray_of_array ats
let r be _function_type rt cta (array.length ats) false
do unsafe_free cta
be r
# Z.Z.Z. Operations on Parameters
val:c arity : value φ → int := "LLVMCountParams"
val:c param : value φ → int → value φ := "LLVMGetParam"
# Z.Z.Z. Operations on Basic Blocks
type:c block φ := "LLVMBasicBlockRef"
val:c value_of_block : block φ → value φ := "LLVMBasicBlockAsValue"
val:c value_is_block : value φ → bool := "LLVMValueIsBasicBlock"
val:c value_to_block : value φ → block φ := "LLVMValueAsBasicBlock"
val:c get_block_parent : block φ → φ /~ value φ := "LLVMGetBasicBlockParent"
val:c block_count : value φ → φ /~ int := "LLVMCountBasicBlocks"
val:c first_block : value φ → φ /~ block φ := "LLVMGetFirstBasicBlock"
val:c last_block : value φ → φ /~ block φ := "LLVMGetLastBasicBlock"
val:c next_block : block φ → φ /~ block φ := "LLVMGetNextBasicBlock"
val:c prev_block : block φ → φ /~ block φ := "LLVMGetPreviousBasicBlock"
val:c entry_block : value φ → φ /~ block φ := "LLVMGetEntryBasicBlock"
val:c append_block : context φ → value φ → string → φ /~ block φ
:= "LLVMAppendBasicBlockInContext"
val:c insert_block : context φ → block φ → string → φ /~ block φ
:= "LLVMInsertBasicBlockInContext"
val:c delete_block : block φ → φ /~ unit
:= "LLVMDeleteBasicBlock"
val:c move_block_before : block φ → block φ → φ /~ unit
:= "LLVMMoveBasicBlockBefore"
val:c move_block_after : block φ → block φ → φ /~ unit
:= "LLVMMoveBasicBlockAfter"
# Z.Z. Instruction Builders
type:c builder φ := "LLVMBuilderRef"
val:c create_builder : context φ → φ /~ builder φ
:= "LLVMCreateBuilderInContext"
val:c position_builder : builder φ → block φ → value φ → φ /~ unit
:= "LLVMPositionBuilder"
val:c position_builder_before : builder φ → value φ → φ /~ unit
:= "LLVMPositionBuilderBefore"
val:c position_builder_at_end : builder φ → block φ → φ /~ unit
:= "LLVMPositionBuilderAtEnd"
val:c get_insert_block : builder φ → φ /~ block φ
:= "LLVMGetInsertBlock"
val:c clear_insertion_position : builder φ → φ /~ unit
:= "LLVMClearInsertionPosition"
val:c insert_into_builder : builder φ → value φ → string → φ /~ unit
:= "LLVMInsertIntoBuilderWithName"
val:cf dispose_builder : builder φ → φ /~ unit
:= "LLVMDisposeBuilder"
# Z.Z.Z. Metadata
val:c set_current_debug_location : builder φ → value φ → φ /~ unit
:= "LLVMSetCurrentDebugLocation"
val:c get_current_debug_location : builder φ → φ /~ value φ
:= "LLVMGetCurrentDebugLocation"
val:c set_inst_debug_location : builder φ → value φ → φ /~ unit
:= "LLVMSetInstDebugLocation"
# Z.Z.Z. Terminators
val:c build_ret_void : builder φ → φ /~ value φ := "LLVMBuildRetVoid"
val:c build_ret : builder φ → value φ → φ /~ value φ := "LLVMBuildRet"
val build_aggregate_ret : builder φ → array (value φ) → φ /~ value φ
val:c build_br : builder φ → block φ → φ /~ value φ := "LLVMBuildBr"
val:c build_cond_br : builder φ → value φ → block φ → block φ → φ /~ value φ
:= "LLVMBuildCondBr"
val:c build_switch : builder φ → value φ → block φ → int → φ /~ value φ
:= "LLVMBuildSwitch"
val:c add_case : value φ → value φ → block φ → φ /~ unit
:= "LLVMAddCase"
val:c build_indirect_br : builder φ → value φ → int → φ /~ value φ
:= "LLVMBuildIndirectBr"
val:c add_destination : value φ → block φ → φ /~ unit
:= "LLVMAddDestination"
val build_invoke :
builder φ → value φ → array (value φ) → block φ → block φ → string →
φ /~ value φ
val:c build_resume : builder φ → value φ → φ /~ value φ := "LLVMBuildResume"
val:c build_unreachable : builder φ → φ /~ value φ := "LLVMBuildUnreachable"
val:c _build_aggregate_ret : builder φ → ptr φ → int → φ /~ value φ
:= "LLVMBuildAggregateRet"
let! build_aggregate_ret b xa
let ca do foreign.cabi.utils.malloc_ptrarray_of_array xa
let r do _build_aggregate_ret b ca (array.length xa)
do unsafe_free ca
be r
val:c _build_invoke :
builder φ → value φ → ptr φ → int → block φ → block φ → string → φ /~ value φ
:= "LLVMBuildInvoke"
let! build_invoke b f args bb unwind_bb name
let cargs do foreign.cabi.utils.malloc_ptrarray_of_array args
let r do _build_invoke b f cargs (array.length args) bb unwind_bb name
do unsafe_free cargs
be r
# Z.Z.Z. Arithmetic
val:c build_add : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildAdd"
val:c build_nsw_add : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildNSWAdd"
val:c build_nuw_add : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildNUWAdd"
val:c build_fadd : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildFAdd"
val:c build_sub : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildSub"
val:c build_nsw_sub : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildNSWSub"
val:c build_nuw_sub : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildNUWSub"
val:c build_fsub : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildFSub"
val:c build_mul : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildMul"
val:c build_nsw_mul : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildNSWMul"
val:c build_nuw_mul : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildNUWMul"
val:c build_fmul : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildFMul"
val:c build_udiv : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildUDiv"
val:c build_sdiv : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildSDiv"
val:c build_exact_sdiv : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildExactSDiv"
val:c build_fdiv : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildFDiv"
val:c build_urem : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildURem"
val:c build_srem : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildSRem"
val:c build_frem : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildFRem"
val:c build_shl : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildShl"
val:c build_lshr : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildLShr"
val:c build_ashr : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildAShr"
val:c build_and : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildAnd"
val:c build_or : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildOr"
val:c build_xor : builder φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildXor"
val:c build_neg : builder φ → value φ → string → φ /~ value φ
:= "LLVMBuildNeg"
val:c build_nsw_neg : builder φ → value φ → string → φ /~ value φ
:= "LLVMBuildNSWNeg"
val:c build_nuw_neg : builder φ → value φ → string → φ /~ value φ
:= "LLVMBuildNUWNeg"
val:c build_fneg : builder φ → value φ → string → φ /~ value φ
:= "LLVMBuildFNeg"
val:c build_not : builder φ → value φ → string → φ /~ value φ
:= "LLVMBuildNot"
# Z.Z.Z. Memory
# Z.Z.Z. Casts
# Z.Z.Z. Comparisons
val:c build_icmp :
builder φ → iorder#i → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildICmp"
val:c build_fcmp :
builder φ → forder#e → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildFCmp"
# Z.Z.Z. Miscellaneous Instructions
val:c build_phi : builder φ → ltype φ → string → φ /~ value φ
:= "LLVMBuildPhi"
val add_incoming : value φ → array (value φ × block φ) → φ /~ unit
val build_call :
builder φ → value φ → array (value φ) → string → φ /~ value φ
val:c build_select :
builder φ → value φ → value φ → value φ → string → φ /~ value φ
:= "LLVMBuildSelect"
val:c _build_call :
builder φ → value φ → ptr φ → int → string → φ /~ value φ
:= "LLVMBuildCall"
let! build_call b f args name
let cargs do foreign.cabi.utils.malloc_ptrarray_of_array args
let r do _build_call b f cargs (array.length args) name
do unsafe_free cargs
be r
val:c _add_incoming : value φ → ptr φ → ptr φ → int → φ /~ unit
:= "LLVMAddIncoming"
let! add_incoming phi incoming
let n be array.length incoming
let cva do foreign.cabi.utils.malloc_ptrarray_init n
(i ↦ unsafe_custom_load_ptr (fst (array.get i incoming)))
let cba do foreign.cabi.utils.malloc_ptrarray_init n
(i ↦ unsafe_custom_load_ptr (snd (array.get i incoming)))
do _add_incoming phi cva cba n
# Z.Z. Module Providers
in module_provider
type:c t φ := "LLVMModuleProviderRef"
val:c create_for : module φ → φ /~ t φ
:= "LLVMCreateModuleProviderForExistingModule"
val:c dispose : t φ → φ /~ unit := "LLVMDisposeModuleProvider"
# Z.Z. Pass Managers
type function_ph inj _function_ph
type module_ph inj _module_ph
type:c pass_manager μ φ := "LLVMPassManagerRef"
in module_pass_manager
type t φ := pass_manager module_ph φ
val:c create : φ /~ t φ := "LLVMCreatePassManager"
val:c run : t φ → module φ → φ /~ bool := "LLVMRunPassManager"
val:c dispose : t φ → φ /~ unit := "LLVMDisposePassManager"
in function_pass_manager
type t φ := pass_manager function_ph φ
val:c create : module φ → φ /~ t φ
:= "LLVMCreateFunctionPassManagerForModule"
val:c initialize : t φ → φ /~ bool := "LLVMInitializeFunctionPassManager"
val:c run : t φ → value φ → φ /~ bool := "LLVMRunFunctionPassManager"
val:c finalize : t φ → φ /~ bool := "LLVMFinalizeFunctionPassManager"
val:c dispose : t φ → φ /~ unit := "LLVMDisposePassManager"