From 4689a2881db725948f08fabf9eb0f8ffb2b2cb51 Mon Sep 17 00:00:00 2001
From: Josh Berdine <jjb@fb.com>
Date: Wed, 24 Mar 2021 14:17:36 -0700
Subject: [PATCH] [sledge][llvm] Add LLVMInternalizePredicateBindings

Summary: This patch exposes the predicate API of internalize pass to OCaml.

Reviewed By: jvillard

Differential Revision: D27188305

fbshipit-source-id: d53bf5871
---
 .../bindings/ocaml/transforms/ipo/ipo_ocaml.c | 34 ++++++++++++++++++-
 .../bindings/ocaml/transforms/ipo/llvm_ipo.ml | 11 ++++++
 .../ocaml/transforms/ipo/llvm_ipo.mli         |  6 ++++
 3 files changed, 50 insertions(+), 1 deletion(-)

diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c
index 9fcaa1053..729b54dc6 100644
--- a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c
+++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/ipo_ocaml.c
@@ -15,9 +15,14 @@
 |*                                                                            *|
 \*===----------------------------------------------------------------------===*/
 
+#include <assert.h>
+#include "llvm-c/Core.h"
 #include "llvm-c/Transforms/IPO.h"
-#include "caml/mlvalues.h"
+#include "caml/alloc.h"
+#include "caml/callback.h"
+#include "caml/memory.h"
 #include "caml/misc.h"
+#include "caml/mlvalues.h"
 
 /* [`Module] Llvm.PassManager.t -> unit */
 CAMLprim value llvm_add_argument_promotion(LLVMPassManagerRef PM) {
@@ -97,6 +102,33 @@ CAMLprim value llvm_add_internalize(LLVMPassManagerRef PM, value AllButMain) {
   return Val_unit;
 }
 
+/* string -> bool */
+static value *predicate_f = NULL;
+
+LLVMBool MustPreserveCallBack(LLVMValueRef Val, void* Ctx) {
+  CAMLparam0();
+  CAMLlocal1(LLVMValName);
+  const char *llvmValName;
+  LLVMBool ret;
+  assert(predicate_f != NULL
+         && "llvm_add_internalize_predicate must be called with \
+             LLVMInternalizePredicateCallback symbol set");
+
+  llvmValName = LLVMGetValueName(Val);
+  LLVMValName = caml_copy_string(llvmValName);
+  ret = Bool_val(caml_callback(*predicate_f, LLVMValName));
+
+  CAMLreturnT(LLVMBool, ret);
+}
+
+/* [`Module] Llvm.PassManager.t -> unit */
+CAMLprim value llvm_add_internalize_predicate(LLVMPassManagerRef PM) {
+  predicate_f = caml_named_value("LLVMInternalizePredicateCallback");
+  LLVMAddInternalizePassWithMustPreservePredicate(PM, NULL,
+                                                  &MustPreserveCallBack);
+  return Val_unit;
+}
+
 /* [`Module] Llvm.PassManager.t -> unit */
 CAMLprim value llvm_add_strip_dead_prototypes(LLVMPassManagerRef PM) {
   LLVMAddStripDeadPrototypesPass(PM);
diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml
index 1fb5594fc..4617b688f 100644
--- a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml
+++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.ml
@@ -45,6 +45,17 @@ external add_ipsccp
 external add_internalize
   : [ `Module ] Llvm.PassManager.t -> all_but_main:bool -> unit
   = "llvm_add_internalize"
+
+external add_internalize_predicate_raw
+  : [ `Module ] Llvm.PassManager.t -> unit
+  = "llvm_add_internalize_predicate"
+
+let add_internalize_predicate 
+  : [ `Module ] Llvm.PassManager.t -> (string -> bool) -> unit =
+  fun pm predicate ->
+    Callback.register "LLVMInternalizePredicateCallback" predicate;
+    add_internalize_predicate_raw pm
+
 external add_strip_dead_prototypes
   : [ `Module ] Llvm.PassManager.t -> unit
   = "llvm_add_strip_dead_prototypes"
diff --git a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli
index 6507c5d92..8d48702a2 100644
--- a/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli
+++ b/sledge/vendor/llvm-dune/llvm-project/llvm/bindings/ocaml/transforms/ipo/llvm_ipo.mli
@@ -76,6 +76,12 @@ external add_internalize
   : [ `Module ] Llvm.PassManager.t -> all_but_main:bool -> unit
   = "llvm_add_internalize"
 
+(** See the [llvm::createInternalizePass] function.
+    If predicate returns [true], that symbol is preserved.
+    NOT THREAD SAFE! *)
+val add_internalize_predicate
+  : [ `Module ] Llvm.PassManager.t -> (string -> bool) -> unit
+
 (** See the [llvm::createStripDeadPrototypesPass] function. *)
 external add_strip_dead_prototypes
   : [ `Module ] Llvm.PassManager.t -> unit