Commits

camlspotter  committed 3c44f80

type safe gep!

  • Participants
  • Parent commits 4a206de

Comments (0)

Files changed (3)

 OCAML_LIB_FLAGS +=
 
 MyOCamlPackage(llvm_phantom, $(FILES), $(EMPTY), $(EMPTY))
+
+printer: printer.ml
+    ocamlfind ocamlc -linkpkg -package spotlib -o printer printer.ml
     unsafeM (Llvm.build_gep !<v (Array.of_list (List.map (!<) xs)) name)
 
   module Gep : sig
-    type 'a gep
-    val start_ : ?name:string -> 'a pointer v -> ('a pointer gep -> 'b) -> 'b
-    val end_ : 'a gep -> 'a pointer v m
-    val pos : int -> [> `container of 'a] gep -> ('a gep -> 'b) -> 'b
-    val pos_dyn : i32 v -> [> `container of 'a] gep -> ('a gep -> 'b) -> 'b
-    val mem1 : ('a1 * _, Llvm.llvalue) P.ts struct_ gep -> ('a1 gep -> 'b) -> 'b
-    val mem2 : (_ * ('a2 * _), Llvm.llvalue) P.ts struct_ gep -> ('a2 gep -> 'b) -> 'b
+    type 'a t
+    val gep : ?name:string -> 'a pointer v -> ('a pointer t -> 'b) -> 'b
+    val end_ : 'a t -> 'a pointer v m
+    val pos_const : int -> [> `container of 'a] t -> ('a t -> 'b) -> 'b
+    val pos : i32 v -> [> `container of 'a] t -> ('a t -> 'b) -> 'b
+    val mem0 : ('a0 * _) struct_ t -> ('a0 t -> 'b) -> 'b
+    val mem1 : (_ * ('a1 * _)) struct_ t -> ('a1 t -> 'b) -> 'b
+    val mem2 : (_ * (_ * ('a2 * _))) struct_ t -> ('a2 t -> 'b) -> 'b
+    val mem3 : (_ * (_ * (_ * ('a3 * _)))) struct_ t -> ('a3 t -> 'b) -> 'b
+    val mem4 : (_ * (_ * (_ * (_ * ('a4 * _))))) struct_ t -> ('a4 t -> 'b) -> 'b
+    val mem5 : (_ * (_ * (_ * (_ * (_ * ('a5 * _)))))) struct_ t -> ('a5 t -> 'b) -> 'b
+    val mem6 : (_ * (_ * (_ * (_ * (_ * (_ * ('a6 * _))))))) struct_ t -> ('a6 t -> 'b) -> 'b
+    val mem7 : (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a7 * _)))))))) struct_ t -> ('a7 t -> 'b) -> 'b
+    val mem8 : (_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a8 * _))))))))) struct_ t -> ('a8 t -> 'b) -> 'b
+    val mem9 : (_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a9 * _)))))))))) struct_ t -> ('a9 t -> 'b) -> 'b
   end = struct
-    type 'a gep = (i32 v list -> unknown pointer v m) * i32 v list
-    let start_ ?name (v : 'a pointer v) = 
+    type 'a t = (i32 v list -> unknown pointer v m) * i32 v list
+    let gep ?name (v : 'a pointer v) = 
       let do_gep = unsafe_gep ?name v in
       fun f -> f (do_gep, [])
-    let end_ (do_gep, rev_idx : 'a gep) = magicM ^$ do_gep (List.rev rev_idx)
+    let end_ (do_gep, rev_idx : 'a t) = magicM ^$ do_gep (List.rev rev_idx)
 
-    let pos (n : int) (do_gep, st) (k : 'a gep -> 'b) = 
+    let pos_const (n : int) (do_gep, st) (k : 'a t -> 'b) = 
       k (do_gep, Const.i32_of_int n::st)
-    let pos_dyn (n : i32 v) (do_gep, st) (k : 'a gep -> 'b) = 
+    let pos (n : i32 v) (do_gep, st) (k : 'a t -> 'b) = 
       k (do_gep, n::st)
-    let mem1 (do_gep, st) k = k (do_gep, Const.i32_of_int 1 :: st)
-    let mem2 (do_gep, st) k = k (do_gep, Const.i32_of_int 2 :: st)
+    let mem0  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 0  :: st : _ t)
+    let mem1  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 1  :: st : _ t)
+    let mem2  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 2  :: st : _ t)
+    let mem3  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 3  :: st : _ t)
+    let mem4  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 4  :: st : _ t)
+    let mem5  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 5  :: st : _ t)
+    let mem6  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 6  :: st : _ t)
+    let mem7  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 7  :: st : _ t)
+    let mem8  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 8  :: st : _ t)
+    let mem9  (do_gep, st : _ t) k = k (do_gep, Const.i32_of_int 9  :: st : _ t)
   end
 
-  let gep_start = Gep.start_
-  let gep_end = Gep.end_
+  let gep = Gep.gep
 
   let load 
       ?(name="loaded")
       : unit m = 
     Monad.ignore (Llvm.build_store !<x !<dst)
 
+  (* opposite order! *)
+  let unsafe_const_store ptr indices lv = perform
+      gepped <-- unsafe_gep ~name:"for_store" ptr (List.map Const.i32_of_int indices);
+      Monad.ignore (store lv ~dst:gepped)
+
+
   let ret x : unit m = Monad.ignore (Llvm.build_ret !<x)
   let ret_void : unit m = Monad.ignore Llvm.build_ret_void
 

File lbuilder_intf.ml

   val global_stringptr : ?name:string -> string -> i8 pointer v m
 
   val unsafe_gep : ?name:string -> 'a pointer v -> i32 v list -> 'unsafe pointer v m
-    
+
+  module Gep : sig
+    type 'a t (** a phantom for type safe GEP *)
+    val end_ : 'a t -> 'a pointer v m
+    val pos_const : int -> [> `container of 'a] t -> ('a t -> 'b) -> 'b
+    val pos : i32 v -> [> `container of 'a] t -> ('a t -> 'b) -> 'b
+    val mem0 : ('a0 * _) struct_ t -> ('a0 t -> 'b) -> 'b
+    val mem1 : (_ * ('a1 * _)) struct_ t -> ('a1 t -> 'b) -> 'b
+    val mem2 : (_ * (_ * ('a2 * _))) struct_ t -> ('a2 t -> 'b) -> 'b
+    val mem3 : (_ * (_ * (_ * ('a3 * _)))) struct_ t -> ('a3 t -> 'b) -> 'b
+    val mem4 : (_ * (_ * (_ * (_ * ('a4 * _))))) struct_ t -> ('a4 t -> 'b) -> 'b
+    val mem5 : (_ * (_ * (_ * (_ * (_ * ('a5 * _)))))) struct_ t -> ('a5 t -> 'b) -> 'b
+    val mem6 : (_ * (_ * (_ * (_ * (_ * (_ * ('a6 * _))))))) struct_ t -> ('a6 t -> 'b) -> 'b
+    val mem7 : (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a7 * _)))))))) struct_ t -> ('a7 t -> 'b) -> 'b
+    val mem8 : (_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a8 * _))))))))) struct_ t -> ('a8 t -> 'b) -> 'b
+    val mem9 : (_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * (_ * ('a9 * _)))))))))) struct_ t -> ('a9 t -> 'b) -> 'b
+  end 
+
+  val gep : ?name:string -> 'a pointer v -> ('a pointer Gep.t -> 'b) -> 'b
+
   val load : ?name:string -> 'a pointer v -> 'a v m
   val store : 'a v -> dst:'a pointer v -> unit m