Skip to content

Commit ff616cb

Browse files
edwintorokedwintorok
committed
OCaml bindings: add some missing functions and testcases.
The C bindings exposed some APIs that weren't covered by the OCaml bindings git-svn-id: https://llvm.org/svn/llvm-project/llvm/trunk@141997 91177308-0d34-0410-b5e6-96231b3b80d8
1 parent 0be167b commit ff616cb

File tree

8 files changed

+301
-4
lines changed

8 files changed

+301
-4
lines changed

‎bindings/ocaml/llvm/llvm.ml

+14
Original file line numberDiff line numberDiff line change
@@ -261,6 +261,7 @@ external set_data_layout: string -> llmodule -> unit
261261
external dump_module : llmodule -> unit = "llvm_dump_module"
262262
external set_module_inline_asm : llmodule -> string -> unit
263263
= "llvm_set_module_inline_asm"
264+
external module_context : llmodule -> llcontext = "LLVMGetModuleContext"
264265

265266
(*===-- Types -------------------------------------------------------------===*)
266267
external classify_type : lltype -> TypeKind.t = "llvm_classify_type"
@@ -321,6 +322,7 @@ external vector_size : lltype -> int = "llvm_vector_size"
321322
(*--... Operations on other types ..........................................--*)
322323
external void_type : llcontext -> lltype = "llvm_void_type"
323324
external label_type : llcontext -> lltype = "llvm_label_type"
325+
external type_by_name : llmodule -> string -> lltype option = "llvm_type_by_name"
324326

325327
external classify_value : llvalue -> ValueKind.t = "llvm_classify_value"
326328
(*===-- Values ------------------------------------------------------------===*)
@@ -812,6 +814,8 @@ external block_end : llvalue -> (llvalue, llbasicblock) llrev_pos
812814
= "llvm_block_end"
813815
external block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
814816
= "llvm_block_pred"
817+
external block_terminator : llbasicblock -> llvalue option =
818+
"llvm_block_terminator"
815819

816820
let rec iter_block_range f i e =
817821
if i = e then () else
@@ -936,6 +940,7 @@ external add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
936940
= "llvm_add_incoming"
937941
external incoming : llvalue -> (llvalue * llbasicblock) list = "llvm_incoming"
938942

943+
external delete_instruction : llvalue -> unit = "llvm_delete_instruction"
939944

940945
(*===-- Instruction builders ----------------------------------------------===*)
941946
external builder : llcontext -> llbuilder = "llvm_builder"
@@ -978,8 +983,15 @@ external build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder ->
978983
llvalue = "llvm_build_cond_br"
979984
external build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
980985
= "llvm_build_switch"
986+
external build_malloc : lltype -> string -> llbuilder -> llvalue =
987+
"llvm_build_malloc"
988+
external build_array_malloc : lltype -> llvalue -> string -> llbuilder ->
989+
llvalue = "llvm_build_array_malloc"
990+
external build_free : llvalue -> llbuilder -> llvalue = "llvm_build_free"
981991
external add_case : llvalue -> llvalue -> llbasicblock -> unit
982992
= "llvm_add_case"
993+
external switch_default_dest : llvalue -> llbasicblock =
994+
"LLVMGetSwitchDefaultDest"
983995
external build_indirect_br : llvalue -> int -> llbuilder -> llvalue
984996
= "llvm_build_indirect_br"
985997
external add_destination : llvalue -> llbasicblock -> unit
@@ -990,6 +1002,8 @@ external build_invoke : llvalue -> llvalue array -> llbasicblock ->
9901002
external build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
9911003
llvalue = "llvm_build_landingpad"
9921004
external set_cleanup : llvalue -> bool -> unit = "llvm_set_cleanup"
1005+
external add_clause : llvalue -> llvalue -> unit = "llvm_add_clause"
1006+
external build_resume : llvalue -> llbuilder -> llvalue = "llvm_build_resume"
9931007
external build_unreachable : llbuilder -> llvalue = "llvm_build_unreachable"
9941008

9951009
(*--... Arithmetic .........................................................--*)

‎bindings/ocaml/llvm/llvm.mli

+39-2
Original file line numberDiff line numberDiff line change
@@ -363,7 +363,9 @@ val dump_module : llmodule -> unit
363363
the method [llvm::Module::setModuleInlineAsm]. *)
364364
val set_module_inline_asm : llmodule -> string -> unit
365365

366-
366+
(** [module_context m] returns the context of the specified module.
367+
* See the method [llvm::Module::getContext] *)
368+
val module_context : llmodule -> llcontext
367369

368370
(** {6 Types} *)
369371

@@ -552,6 +554,11 @@ val void_type : llcontext -> lltype
552554
[llvm::Type::LabelTy]. *)
553555
val label_type : llcontext -> lltype
554556

557+
(** [type_by_name m name] returns the specified type from the current module
558+
* if it exists.
559+
* See the method [llvm::Module::getTypeByName] *)
560+
val type_by_name : llmodule -> string -> lltype option
561+
555562
(* {6 Values} *)
556563

557564
(** [type_of v] returns the type of the value [v].
@@ -1508,6 +1515,7 @@ val block_end : llvalue -> (llvalue, llbasicblock) llrev_pos
15081515
See the method [llvm::Function::iterator::operator--]. *)
15091516
val block_pred : llbasicblock -> (llvalue, llbasicblock) llrev_pos
15101517

1518+
val block_terminator : llbasicblock -> llvalue option
15111519

15121520
(** [rev_iter_blocks f fn] applies function [f] to each of the basic blocks
15131521
of function [fn] in reverse order. Tail recursive. *)
@@ -1625,7 +1633,9 @@ val add_incoming : (llvalue * llbasicblock) -> llvalue -> unit
16251633
See the method [llvm::PHINode::getIncomingValue]. *)
16261634
val incoming : llvalue -> (llvalue * llbasicblock) list
16271635

1628-
1636+
(** [delete_instruction i] deletes the instruction [i].
1637+
* See the method [llvm::Instruction::eraseFromParent]. *)
1638+
val delete_instruction : llvalue -> unit
16291639

16301640
(** {6 Instruction builders} *)
16311641

@@ -1739,12 +1749,30 @@ val build_cond_br : llvalue -> llbasicblock -> llbasicblock -> llbuilder ->
17391749
See the method [llvm::LLVMBuilder::CreateSwitch]. *)
17401750
val build_switch : llvalue -> llbasicblock -> int -> llbuilder -> llvalue
17411751

1752+
(** [build_malloc ty name b] creates an [malloc]
1753+
instruction at the position specified by the instruction builder [b].
1754+
See the method [llvm::CallInst::CreateMalloc]. *)
1755+
val build_malloc : lltype -> string -> llbuilder -> llvalue
1756+
1757+
(** [build_array_malloc ty val name b] creates an [array malloc]
1758+
instruction at the position specified by the instruction builder [b].
1759+
See the method [llvm::CallInst::CreateArrayMalloc]. *)
1760+
val build_array_malloc : lltype -> llvalue -> string -> llbuilder -> llvalue
1761+
1762+
(** [build_free p b] creates a [free]
1763+
instruction at the position specified by the instruction builder [b].
1764+
See the method [llvm::LLVMBuilder::CreateFree]. *)
1765+
val build_free : llvalue -> llbuilder -> llvalue
17421766

17431767
(** [add_case sw onval bb] causes switch instruction [sw] to branch to [bb]
17441768
when its input matches the constant [onval].
17451769
See the method [llvm::SwitchInst::addCase]. **)
17461770
val add_case : llvalue -> llvalue -> llbasicblock -> unit
17471771

1772+
(** [switch_default_dest sw] returns the default destination of the [switch]
1773+
* instruction.
1774+
* See the method [llvm:;SwitchInst::getDefaultDest]. **)
1775+
val switch_default_dest : llvalue -> llbasicblock
17481776

17491777
(** [build_indirect_br addr count b] creates a
17501778
[indirectbr %addr]
@@ -1778,6 +1806,15 @@ val build_landingpad : lltype -> llvalue -> int -> string -> llbuilder ->
17781806
See the method [llvm::LandingPadInst::setCleanup]. *)
17791807
val set_cleanup : llvalue -> bool -> unit
17801808

1809+
(** [add_clause lp clause] adds the clause to the [landingpad]instruction.
1810+
See the method [llvm::LandingPadInst::addClause]. *)
1811+
val add_clause : llvalue -> llvalue -> unit
1812+
1813+
(* [build_resume exn b] builds a [resume exn] instruction
1814+
* at the position specified by the instruction builder [b].
1815+
* See the method [llvm::LLVMBuilder::CreateResume] *)
1816+
val build_resume : llvalue -> llbuilder -> llvalue
1817+
17811818
(** [build_unreachable b] creates an
17821819
[unreachable]
17831820
instruction at the position specified by the instruction builder [b].

‎bindings/ocaml/llvm/llvm_ocaml.c

+67
Original file line numberDiff line numberDiff line change
@@ -387,6 +387,18 @@ CAMLprim LLVMTypeRef llvm_label_type(LLVMContextRef Context) {
387387
return LLVMLabelTypeInContext(Context);
388388
}
389389

390+
CAMLprim value llvm_type_by_name(LLVMModuleRef M, value Name)
391+
{
392+
CAMLparam1(Name);
393+
LLVMTypeRef Ty = LLVMGetTypeByName(M, String_val(Name));
394+
if (Ty) {
395+
value Option = alloc(1, 0);
396+
Field(Option, 0) = (value) Ty;
397+
CAMLreturn(Option);
398+
}
399+
CAMLreturn(Val_int(0));
400+
}
401+
390402
/*===-- VALUES ------------------------------------------------------------===*/
391403

392404
/* llvalue -> lltype */
@@ -1098,6 +1110,19 @@ CAMLprim value llvm_set_param_alignment(LLVMValueRef Arg, value align) {
10981110
DEFINE_ITERATORS(
10991111
block, BasicBlock, LLVMValueRef, LLVMBasicBlockRef, LLVMGetBasicBlockParent)
11001112

1113+
/* llbasicblock -> llvalue option */
1114+
CAMLprim value llvm_block_terminator(LLVMBasicBlockRef Block)
1115+
{
1116+
CAMLparam0();
1117+
LLVMValueRef Term = LLVMGetBasicBlockTerminator(Block);
1118+
if (Term) {
1119+
value Option = alloc(1, 0);
1120+
Field(Option, 0) = (value) Term;
1121+
CAMLreturn(Option);
1122+
}
1123+
CAMLreturn(Val_int(0));
1124+
}
1125+
11011126
/* llvalue -> llbasicblock array */
11021127
CAMLprim value llvm_basic_blocks(LLVMValueRef Fn) {
11031128
value MLArray = alloc(LLVMCountBasicBlocks(Fn), 0);
@@ -1232,6 +1257,11 @@ CAMLprim value llvm_incoming(LLVMValueRef PhiNode) {
12321257
CAMLreturn(Tl);
12331258
}
12341259

1260+
/* llvalue -> unit */
1261+
CAMLprim value llvm_delete_instruction(LLVMValueRef Instruction) {
1262+
LLVMInstructionEraseFromParent(Instruction);
1263+
return Val_unit;
1264+
}
12351265

12361266
/*===-- Instruction builders ----------------------------------------------===*/
12371267

@@ -1359,6 +1389,27 @@ CAMLprim LLVMValueRef llvm_build_switch(LLVMValueRef Of,
13591389
return LLVMBuildSwitch(Builder_val(B), Of, Else, Int_val(EstimatedCount));
13601390
}
13611391

1392+
/* lltype -> string -> llbuilder -> llvalue */
1393+
CAMLprim LLVMValueRef llvm_build_malloc(LLVMTypeRef Ty, value Name,
1394+
value B)
1395+
{
1396+
return LLVMBuildMalloc(Builder_val(B), Ty, String_val(Name));
1397+
}
1398+
1399+
/* lltype -> llvalue -> string -> llbuilder -> llvalue */
1400+
CAMLprim LLVMValueRef llvm_build_array_malloc(LLVMTypeRef Ty,
1401+
LLVMValueRef Val,
1402+
value Name, value B)
1403+
{
1404+
return LLVMBuildArrayMalloc(Builder_val(B), Ty, Val, String_val(Name));
1405+
}
1406+
1407+
/* llvalue -> llbuilder -> llvalue */
1408+
CAMLprim LLVMValueRef llvm_build_free(LLVMValueRef P, value B)
1409+
{
1410+
return LLVMBuildFree(Builder_val(B), P);
1411+
}
1412+
13621413
/* llvalue -> llvalue -> llbasicblock -> unit */
13631414
CAMLprim value llvm_add_case(LLVMValueRef Switch, LLVMValueRef OnVal,
13641415
LLVMBasicBlockRef Dest) {
@@ -1399,19 +1450,35 @@ CAMLprim LLVMValueRef llvm_build_invoke_bc(value Args[], int NumArgs) {
13991450
Args[4], Args[5]);
14001451
}
14011452

1453+
/* lltype -> llvalue -> int -> string -> llbuilder -> llvalue */
14021454
CAMLprim LLVMValueRef llvm_build_landingpad(LLVMTypeRef Ty, LLVMValueRef PersFn,
14031455
value NumClauses, value Name,
14041456
value B) {
14051457
return LLVMBuildLandingPad(Builder_val(B), Ty, PersFn, Int_val(NumClauses),
14061458
String_val(Name));
14071459
}
14081460

1461+
/* llvalue -> llvalue -> unit */
1462+
CAMLprim value llvm_add_clause(LLVMValueRef LandingPadInst, LLVMValueRef ClauseVal)
1463+
{
1464+
LLVMAddClause(LandingPadInst, ClauseVal);
1465+
return Val_unit;
1466+
}
1467+
1468+
1469+
/* llvalue -> bool -> unit */
14091470
CAMLprim value llvm_set_cleanup(LLVMValueRef LandingPadInst, value flag)
14101471
{
14111472
LLVMSetCleanup(LandingPadInst, Bool_val(flag));
14121473
return Val_unit;
14131474
}
14141475

1476+
/* llvalue -> llbuilder -> llvalue */
1477+
CAMLprim LLVMValueRef llvm_build_resume(LLVMValueRef Exn, value B)
1478+
{
1479+
return LLVMBuildResume(Builder_val(B), Exn);
1480+
}
1481+
14151482
/* llbuilder -> llvalue */
14161483
CAMLprim LLVMValueRef llvm_build_unreachable(value B) {
14171484
return LLVMBuildUnreachable(Builder_val(B));

‎bindings/ocaml/transforms/scalar/llvm_scalar_opts.ml

+39
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,15 @@ external add_aggressive_dce : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
2020
external
2121
add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
2222
= "llvm_add_scalar_repl_aggregation"
23+
24+
external
25+
add_scalar_repl_aggregation_ssa : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
26+
= "llvm_add_scalar_repl_aggregation_ssa"
27+
28+
external
29+
add_scalar_repl_aggregation_with_threshold : int -> [<Llvm.PassManager.any] Llvm.PassManager.t
30+
-> unit
31+
= "llvm_add_scalar_repl_aggregation_with_threshold"
2332
external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t
2433
-> unit
2534
= "llvm_add_ind_var_simplification"
@@ -67,6 +76,36 @@ external add_memcpy_opt : [<Llvm.PassManager.any] Llvm.PassManager.t
6776
external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t
6877
-> unit
6978
= "llvm_add_loop_deletion"
79+
80+
external add_loop_idiom : [<Llvm.PassManager.any] Llvm.PassManager.t
81+
-> unit
82+
= "llvm_add_loop_idiom"
83+
7084
external
7185
add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
7286
= "llvm_add_lib_call_simplification"
87+
88+
external
89+
add_verifier : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
90+
= "llvm_add_verifier"
91+
92+
external
93+
add_correlated_value_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
94+
= "llvm_add_correlated_value_propagation"
95+
96+
external
97+
add_early_cse : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
98+
= "llvm_add_early_cse"
99+
100+
external
101+
add_lower_expect_intrinsic : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
102+
= "llvm_add_lower_expect_intrinsic"
103+
104+
external
105+
add_type_based_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
106+
= "llvm_add_type_based_alias_analysis"
107+
108+
external
109+
add_basic_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
110+
= "llvm_add_basic_alias_analysis"
111+

‎bindings/ocaml/transforms/scalar/llvm_scalar_opts.mli

+46
Original file line numberDiff line numberDiff line change
@@ -35,6 +35,17 @@ external
3535
add_scalar_repl_aggregation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
3636
= "llvm_add_scalar_repl_aggregation"
3737

38+
(** See the [llvm::createScalarReplAggregatesPassSSA] function. *)
39+
external
40+
add_scalar_repl_aggregation_ssa : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
41+
= "llvm_add_scalar_repl_aggregation_ssa"
42+
43+
(** See the [llvm::createScalarReplAggregatesWithThreshold] function. *)
44+
external
45+
add_scalar_repl_aggregation_with_threshold : int -> [<Llvm.PassManager.any] Llvm.PassManager.t
46+
-> unit
47+
= "llvm_add_scalar_repl_aggregation_with_threshold"
48+
3849
(** See the [llvm::createIndVarSimplifyPass] function. *)
3950
external add_ind_var_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t
4051
-> unit
@@ -112,7 +123,42 @@ external add_loop_deletion : [<Llvm.PassManager.any] Llvm.PassManager.t
112123
-> unit
113124
= "llvm_add_loop_deletion"
114125

126+
external add_loop_idiom : [<Llvm.PassManager.any] Llvm.PassManager.t
127+
-> unit
128+
= "llvm_add_loop_idiom"
129+
115130
(** See the [llvm::createSimplifyLibCallsPass] function. *)
116131
external
117132
add_lib_call_simplification : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
118133
= "llvm_add_lib_call_simplification"
134+
135+
(** See the [llvm::createVerifierPass] function. *)
136+
external
137+
add_verifier : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
138+
= "llvm_add_verifier"
139+
140+
(** See the [llvm::createCorrelatedValuePropagationPass] function. *)
141+
external
142+
add_correlated_value_propagation : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
143+
= "llvm_add_correlated_value_propagation"
144+
145+
(** See the [llvm::createEarlyCSE] function. *)
146+
external
147+
add_early_cse : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
148+
= "llvm_add_early_cse"
149+
150+
(** See the [llvm::createLowerExpectIntrinsicPass] function. *)
151+
external
152+
add_lower_expect_intrinsic : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
153+
= "llvm_add_lower_expect_intrinsic"
154+
155+
(** See the [llvm::createTypeBasedAliasAnalysisPass] function. *)
156+
external
157+
add_type_based_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
158+
= "llvm_add_type_based_alias_analysis"
159+
160+
(** See the [llvm::createBasicAliasAnalysisPass] function. *)
161+
external
162+
add_basic_alias_analysis : [<Llvm.PassManager.any] Llvm.PassManager.t -> unit
163+
= "llvm_add_basic_alias_analysis"
164+

0 commit comments

Comments
 (0)