Commits

camlspotter committed 53ea0be

added generalized gep tool

  • Participants
  • Parent commits 89b10be

Comments (0)

Files changed (1)

+open Llvm
+open Ltype.Base
+
+(* Tools for type safe GEP *)
+module M : sig
+  type ('a, 'b) t
+
+  val gep : ([`int of int | `llvalue of llvalue] list -> 'b) -> ('a, 'b) t
+  val end_ : ('a, 'b) t -> 'b
+
+  val pos_const : int -> ([> `container of 'a], 'z) t -> (('a, 'z) t -> 'b) -> 'b
+  val pos : llvalue -> ([> `container of 'a], 'z) t -> (('a, 'z) t -> 'b) -> 'b
+  val mem0 : (('a0 * _) struct_, 'z) t -> (('a0, 'z) t -> 'b) -> 'b
+  val mem1 : ((_ * ('a1 * _)) struct_, 'z) t -> (('a1, 'z) t -> 'b) -> 'b
+  val mem2 : ((_ * (_ * ('a2 * _))) struct_, 'z) t -> (('a2, 'z) t -> 'b) -> 'b
+  val mem3 : ((_ * (_ * (_ * ('a3 * _)))) struct_, 'z) t -> (('a3, 'z) t -> 'b) -> 'b
+  val mem4 : ((_ * (_ * (_ * (_ * ('a4 * _))))) struct_, 'z) t -> (('a4, 'z) t -> 'b) -> 'b
+  val mem5 : ((_ * (_ * (_ * (_ * (_ * ('a5 * _)))))) struct_, 'z) t -> (('a5, 'z) t -> 'b) -> 'b
+  val mem6 : ((_ * (_ * (_ * (_ * (_ * (_ * ('a6 * _))))))) struct_, 'z) t -> (('a6, 'z) t -> 'b) -> 'b
+  val mem7 : ((_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a7 * _)))))))) struct_, 'z) t -> (('a7, 'z) t -> 'b) -> 'b
+  val mem8 : ((_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a8 * _))))))))) struct_, 'z) t -> (('a8, 'z) t -> 'b) -> 'b
+  val mem9 : ((_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a9 * _)))))))))) struct_, 'z) t -> (('a9, 'z) t -> 'b) -> 'b
+end = struct
+  type ('a, 'z) t = { rev : [`int of int | `llvalue of llvalue] list;
+                      k : [`int of int | `llvalue of llvalue] list -> 'z;
+                    }
+
+  let gep k = { rev = []; k = k }
+  let end_ st = st.k st.rev
+
+  let pos_const (n : int) st k = k { st with rev = `int n::st.rev }
+  let pos (n : llvalue) st k = k { st with rev = `llvalue n::st.rev }
+  let mem0 st k = k { st with rev = `int 0  :: st.rev }
+  let mem1 st k = k { st with rev = `int 1  :: st.rev }
+  let mem2 st k = k { st with rev = `int 2  :: st.rev }
+  let mem3 st k = k { st with rev = `int 3  :: st.rev }
+  let mem4 st k = k { st with rev = `int 4  :: st.rev }
+  let mem5 st k = k { st with rev = `int 5  :: st.rev }
+  let mem6 st k = k { st with rev = `int 6  :: st.rev }
+  let mem7 st k = k { st with rev = `int 7  :: st.rev }
+  let mem8 st k = k { st with rev = `int 8  :: st.rev }
+  let mem9 st k = k { st with rev = `int 9  :: st.rev }
+end
+
+include M