1. camlspotter
  2. ocaml-llvm-phantom

Commits

camlspotter  committed 061b574

comments

  • Participants
  • Parent commits ba20d05
  • Branches default

Comments (0)

Files changed (6)

File lib/build_intf.ml

View file
 open Phantom
 open Type
 open Value
+open Llvm
 
 module type S = sig
 
-  (** Builder monad *)
+  (** {5 Builder monad}
+
+      In Llvm.mli, llbuilder is a handle which is required almost of all the building functions.
+      This is just a state so we introduce a monad to apply it implicitly.
+  *)
 
   module Monad : sig
-    include Monad_intf.T with type 'a t = Llvm.llbuilder -> 'a
+    include Monad_intf.T with type 'a t = llbuilder -> 'a
     val run : 'a t -> 'a
   end
   type 'a m = 'a Monad.t
 
   val build : 'a m -> 'a
-    (** [build m] runs the code gen store in the monad [m] *)
+  (** [build m] runs the code gen stored in the monad [m] *)
 
-  (** Lifted value coercions *)      
+  (** {6 Lifted value coercions } *)
+
   val unknownM : 'a v m -> unknown v m
   val magicM : 'a v m -> 'b v m
 
-
-
-  (** Function calls *)
+  (** {6 Function calls} *)
 
   val call : ?name:string -> ('a -> 'b) pointer v -> 'a vs -> 'b v m
   val call_va_args : ?name: string -> ('a -> dots -> 'b) pointer v -> 'a vs -> unknown v list -> 'b v m
 
 
 
-  (** String *)
+  (** {6 String} *)
   val global_stringptr : ?name:string -> string -> i8 pointer v m
 
 
 
-  (** Pointers *)
+  (** {6 Pointers} *)
 
   val is_null : ?name:string -> 'a pointer v -> i1 v m
 
 
 
-  (** Casts *)
+  (** {6 Casts} *)
 
   val bitcast : ?name:string -> 'a v -> 'b typ -> 'b v m
   val pointercast : ?name:string -> 'a pointer v -> ([>`int] as 'b) typ -> 'b v m
 
 
 
-  (** Load/Store. Unsafe and type-safe versions *)
+  (** {6 Load/Store. Unsafe and type-safe versions} *)
 
   val unsafe_gep : ?name:string -> 'a pointer v -> i32 v list -> 'unsafe pointer v m
-    
+
   (** Type-safe GEP
-      
+
       Do not be fooled by those complex types. They are pretty easy to use:
 
-      [gep v acc1 acc2 ... accn Gep.end_] provides a type safe version of 
+      [gep v acc1 acc2 ... accn Gep.end_] provides a type safe version of
       [unsafe_gep v [<acc1>; <acc2>; .. ; <accn>]].
 
       Here acci is an accessor, one of the followings:
        - [Gep.pos_i32 n] : Accessing n-th pointer/array/vector elements by llvalue
        - [Gep.mem<i>] : Accessing n-th element of struct
 
-      You must give appropriate accessors: 
+      You must give appropriate accessors:
       for example, you cannot use [pos n] for n-th element of struct.
 
       Do not forget to put Gep.end_ at the end of the accessor list.
       Examples:
 
         - Obtain i32* from i32[20]* p, which points to p[0][n]
-            gep pointer (Gep.pos_const 0) (Gep.pos n) Gep.end_ : i32 pointer v m
+            gep p (Gep.pos_const 0) (Gep.pos n) Gep.end_ : i32 pointer v m
         - Obtain i32* from {i1, i16, i32, i64}* p, which points to the i32 element of the struct *p.
             gep pointer (Gep.pos_const 0) Gep.mem2 Gep.end_ : i32 pointer v m
 
       GEP and load/store are often used in conjunctions, gep_load and gep_store are available for such cases:
 
         - Load i32 p[0][n] of i32[20]* p
-            gep_load pointer (Gep.pos_const 0) (Gep.pos n) Gep.end_ : i32 v m 
+            gep_load pointer (Gep.pos_const 0) (Gep.pos n) Gep.end_ : i32 v m
         - Store the i32 element [v] to the 2nd element of {i1, i16, i32, i64}* p
-            gep_store v ~dst:pointer (Gep.pos_const 0) Gep.mem2 Gep.end_ : i32 v m 
+            gep_store v ~dst:pointer (Gep.pos_const 0) Gep.mem2 Gep.end_ : i32 v m
   *)
-  val gep : ?name:string 
+
+  val gep : ?name:string
             -> 'a pointer v
             -> (('a pointer, 'x, 'x pointer v m) Gep.t -> 'b)
             -> 'b
-  val gep_load : ?name:string 
+  val gep_load : ?name:string
             -> 'a pointer v
             -> (('a pointer, 'x, 'x v m) Gep.t -> 'b)
             -> 'b
 
 
 
-  (** Arithmetic operations *)
+  (** {6 Arithmetic operations} *)
 
   val add :  ?name:string -> ([>`int] as 'a) v -> 'a v -> 'a v m
   val sub :  ?name:string -> ([>`int] as 'a) v -> 'a v -> 'a v m
   val fcmp : Llvm.Fcmp.t -> ?name:string -> ([>`floating] as 'a) v -> 'a v -> i1 v m
 
 
-  (** Arithmetic type conversion *)
+  (** {6 Arithmetic type conversion} *)
 
   val sitofp : ?name:string -> [>`int] v -> ([>`floating] as 'a) typ -> 'a v m
 
 
-  (** Memory *)
+  (** {6 Memory}  *)
 
   val alloca : ?name:string -> 'a typ -> 'a pointer v m
 
 
-  (** Useful libc functions *)
+  (** {6 Useful libc functions} *)
 
   val printf : string -> unknown v list -> unit m
-    (* CR jfuruse: probably (quite unlikely though), we can have a type safer version *)
+  (* CR jfuruse: probably (quite unlikely though), we can have a type safer version *)
 
   val malloc : ?name:string -> ?bzero:bool -> i32 v -> void_pointer v m
-    (** malloc by size. *)
+  (** malloc by size. *)
 
   val malloc_by_ty : ?name:string -> ?bzero:bool -> 'a typ -> 'a pointer v m
-    (** malloc by type.
-        CR: no nelems available. 
-    *)
+  (** malloc by type.
+      CR: no nelems available.
+  *)
 
   val memcpy : dst:void_pointer v -> src:void_pointer v -> size:i32 v -> void_pointer v m
   val bzero : void_pointer v -> size:i32 v -> unit m
   val free : 'a pointer v -> unit m
 
 
-  (** Control flow codegens *)
+  (** {6 Control flow codegens} *)
 
   val ret : 'a v -> unit m
   val ret_void : unit m
-    
-  val phi : ?name:string -> ('a v * Llvm.llbasicblock) list -> 'a v m
 
-  val cond_br : i1 v -> Llvm.llbasicblock -> Llvm.llbasicblock -> unit m
+  val phi : ?name:string -> ('a v * llbasicblock) list -> 'a v m
 
-  val br : Llvm.llbasicblock -> unit m
+  val cond_br : i1 v -> llbasicblock -> llbasicblock -> unit m
 
+  val br : llbasicblock -> unit m
 
 
-  (** Basic blocks *)
+
+  (** {6 Basic blocks} *)
 
   module Block : sig
-    val position_at_end : Llvm.llbasicblock -> unit m
-    val insertion : Llvm.llbasicblock m
-    val append : ?name:string -> ('a -> 'b) pointer v -> Llvm.llbasicblock
-    val parent : Llvm.llbasicblock -> ('a -> 'b) pointer v
+    val position_at_end : llbasicblock -> unit m
+    val insertion : llbasicblock m
+    val append : ?name:string -> ('a -> 'b) pointer v -> llbasicblock
+    val parent : llbasicblock -> ('a -> 'b) pointer v
   end
 
 
 
-  (** Function definition *)
+  (** {6 Function definition} *)
 
-  val func : string -> 'a typ -> ('b, (string * Llvm.lltype)) Phantom.ts
+  val func : string -> 'a typ -> ('b, (string * lltype)) Phantom.ts
     -> ?dump: bool
-    -> (('b -> 'a) pointer v (* self *) -> 'b vs -> 'a v m) 
+    -> (('b -> 'a) pointer v (* self *) -> 'b vs -> 'a v m)
     -> ('b -> 'a) pointer v m
   (** [func name return_type arg_types ?dump f] defines a function of a name [name] whose type is
       [arg_types] -> [return_type]. Its function body is defined by [f].
     -> ((('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8,'a9) tpl10 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'a4 v -> 'a5 v -> 'a6 v -> 'a7 v -> 'a8 v -> 'a9 v -> 'res v m)
     -> (('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8,'a9) tpl10 -> 'res) pointer v m
 
-  (** Connecting basic blocks *)
+  (** {6 Connecting basic blocks} *)
 
-  val return_void : void v m 
+  val return_void : void v m
   (** for functions returning void *)
 
   val current_function : unit -> ('a -> 'b) pointer v m
-  (** Returns the current function. If not in a function, raises Not_found *) 
+  (** Returns the current function. If not in a function, raises Not_found *)
 
-  val append_code_block : 
+  val append_code_block :
     string (* name *)
     -> 'a v m (* codegen *)
-    -> (Llvm.llbasicblock * 'a v * Llvm.llbasicblock) m
+    -> (llbasicblock * 'a v * llbasicblock) m
   (** [append_code_block name vm] appends a basicblock of name [name]
-      using the codegen [vm] in the function being defined currently. 
-      It returns the entering block, the codegen result llvalue, and  
+      using the codegen [vm] in the function being defined currently.
+      It returns the entering block, the codegen result llvalue, and
       the exiting block. *)
 
   val if_then_else : i1 v m -> 'a v m -> 'a v m -> 'a v m
   val imp_if_then_else : i1 v m -> unit m -> unit m -> unit m
   (** Imperative condition: Not_found is raised if not defined in a function. *)
 
-  val for_loop : 
-    'a v (* the init loop value *) 
+  val for_loop :
+    'a v (* the init loop value *)
     -> ('a v -> i1 v m) (* test on the loop value *)
     -> ('a v -> 'a v m) (* the loop job + loop value update *)
     -> unit m
 
 
 
-  (** Execution *)
+  (** {6 Execution} *)
 
   val exec : unit m -> unit
   (** [exec u] creates an anonymous function from [u] and runs it. *)

File lib/extension.mli

View file
 
 module Llvm : sig
   val string_of_lltype : (Llvm.lltype * (string * string)) list -> lltype -> string
-  (** It can print named types and recursive types with mu notation *)
+  (** [string_of_lltype] in LLVM 2.8 has a bug and crashes when it is given a recursive type.
+      This is a fix and can print named types and recursive types with mu notation. *)
+  (* CR jfuruse: check [string_of_lltype] of 3.2 still has this bug *)
 end 

File lib/genvalue.mli

View file
 open Type
 open Llvm_executionengine
 
-(* open Spotlib.Spot.Phantom.Open *)
+(** {6 LLVM value with phantom type} *)
 
 type 'a v = ('a, GenericValue.t) Phantom.t
 type 'a vs = ('a, GenericValue.t) Phantom.ts
 
-(** phantom *)
+(** {6 LLVM <=> OCaml value conversions} *)
+
 (* val unsafe_annotate : GenericValue.t -> 'a v _t = v *)
 
 val of_float : ([>`floating] as 'a) typ -> float -> 'a v

File lib/gep.mli

View file
-(** Type-safe GEP tools *)
+(** {6 Type-safe GEP tools} *)
 
 open Type
 open Value
 
 type ('a, 'final, 'res) t
-  (** GEP phantom *)
+(** GEP phantom *)
 
 val gen : ([ `int of int | `llvalue of Llvm.llvalue ] list -> 'res) -> (('a, 'final, 'res) t -> 'b) -> 'b
-  (** GEP generator *)
+(** GEP generator *)
 
 val end_ : ('final, 'final, 'res) t -> 'res
-  (** GEP finisher *)
+(** GEP finisher *)
 
-(** pointer/array/vector accessors *)
+(** {6 pointer/array/vector accessors} *)
 
 val pos : int -> ([> `container of 'a], 'final, 'res) t -> (('a, 'final, 'res) t -> 'b) -> 'b
 val pos_i32 : i32 v -> ([> `container of 'a], 'final, 'res) t -> (('a, 'final, 'res) t -> 'b) -> 'b
 
-(** struct member accessors *)
+(** {6 struct member accessors} *)
 
 val mem0 : (('a0 * _) struct_, 'final, 'res) t -> (('a0, 'final, 'res) t -> 'b) -> 'b
 val mem1 : ((_ * ('a1 * _)) struct_, 'final, 'res) t -> (('a1, 'final, 'res) t -> 'b) -> 'b

File lib/module_intf.ml

View file
+open Llvm
+
 open Type
 open Value
 
-(* open Spotlib.Spot *)
 open Phantom
 
-(* open Llvm_executionengine (* for GenericValue *) *)
+module type S = sig
 
-module type S = sig
+  (** {6 Modules}
+
+      Module is another state like builder, but rarely created. We here uses ML Functor
+      instead of monad to avoid typing module argument everywhere.
+
+      (We can use monads instead but probably we are fed up with too many binds.)
+  *)
+
   val context : Context.t
   val name : string
   val opt : bool
 
-  val module_ : Llvm.llmodule
-    (** Created module *)
+  val module_ : llmodule
+  (** Created module *)
 
-  (** Functions from Llvm.ml with shorter names *)
+  (** {6 Functions from Llvm.ml with shorter names} *)
 
   val dispose : unit -> unit
-    (** Calls Llvm.dispose_module. Use with care *)
+  (** Calls Llvm.dispose_module. Use with care *)
   val target_triple : unit -> string
   val set_target_triple : string -> unit
   val data_layout : unit -> string
   module ExecutionEngine : sig
     val run_function : ('args -> 'ret) pointer v -> 'args Genvalue.vs -> 'ret Genvalue.v
 
+    (** run_function<i> : (tpl<i> -> 'a) pointer v -> tpl<i>[0] Genvalue.v -> ... -> tpl<i>[i-1] Genvalue.v -> 'a Genvalue.v *)
+
     val run_function0 : (tpl0 -> 'a) pointer v -> unit -> 'a Genvalue.v
     val run_function1 : ('a tpl1 -> 'b) pointer v -> 'a Genvalue.v -> 'b Genvalue.v
     val run_function2 : (('a, 'b) tpl2 -> 'c) pointer v ->

File lib/phantom.mli

View file
-(* This is an autogenerated file. Do not edit. *)
-
 (**
-   Opening this module like Spotlib.Spot.Phantom is NOT recommended. 
-   Instead, open Spotlib.Spot.Phantom.Open. Using a module alias is also helpful:
+   Opening this module is NOT recommended. 
+   Instead, open Phantom.Open. Using a module alias is also helpful:
    
-   module P = Spotlib.Spot.Phantom
+   module P = Phantom
    open P.Open
 *)
 type ('phantom, 'cont) t
 
-(* Rather than open Phantom, I recommend to open Phantom.Open *)
 module Open : sig
   type unknown 
   val unknown : unknown
+
   val (!<) : ('a, 'cont) t -> 'cont
   (** Forget the phantom *)
+
   val (!>) : 'cont -> (unknown, 'cont) t
   (** Safe lift up with the unknown phantom *)
+
   val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
   (** Forget the phantom *)
 end
+
 type unknown = Open.unknown
 val unknown : Open.unknown
 val (!<) : ('a, 'cont) t -> 'cont
 val (!?) : ('a, 'cont) t -> (unknown, 'cont) t
 
 val unsafe : 'cont -> ('unsafe, 'cont) t
-(** [unsafe v] lifts up [v] of [elt] to one with any phantom. Use with care. *)
+(** [unsafe v] lifts up [v] with an arbitrary phantom. Use with care. *)
+
 val magic : ('a, 'cont) t -> ('unsafe, 'cont) t
 (** [magic v] changes the phantom ov [v]. Use with care. *)
 
 val map : ('cont -> 'cont2) -> ('a, 'cont) t -> ('a, 'cont2) t
 val combine : 'tag -> ('a, 'cont) t -> ('a, 'tag * 'cont) t
 
-type ('phantom, 'cont) ts
+type ('phantoms, 'cont) ts
 (** phantom heterogeneous 'cont list *)
 
 module List : sig
   val unsafe_list : 'cont list -> ('unsafe, 'cont) ts
-  (** [unsafe_list ls] lifts up [ls] of [elt list] to a list with any phantom. Use with care. *)
+  (** [unsafe_list ls] lifts up [ls] with arbitrary phantoms. Use with care. *)
   val to_list : ('a, 'cont) ts -> 'cont list
   val to_unknown_list : ('a, 'cont) ts -> (unknown, 'cont) t list
   val to_array : ('a, 'cont) ts -> 'cont array
   val map : ('cont -> 'cont2) -> ('a, 'cont) ts -> ('a, 'cont2) ts
   val combine : 'tag list -> ('a, 'cont) ts -> ('a, ('tag * 'cont)) ts
 
-  type ('phantom, 'cont) t = ('phantom, 'cont) ts
+  type ('phantoms, 'cont) t = ('phantoms, 'cont) ts
 end
 
 (* This encoding is correct only if the parameter cannot be the unit or a tuple *)
 type ('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8) tpl9 = ('a0 * ('a1 * ('a2 * ('a3 * ('a4 * ('a5 * ('a6 * ('a7 * ('a8 * unit)))))))))
 type ('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8,'a9) tpl10 = ('a0 * ('a1 * ('a2 * ('a3 * ('a4 * ('a5 * ('a6 * ('a7 * ('a8 * ('a9 * unit))))))))))
 
+(** {6 Construction of phantom hetero list} *)
+
 val c0 : (tpl0,'c) ts
 val c1 : ('a0,'c) t -> ('a0 tpl1,'c) ts
 val c2 : ('a0,'c) t -> ('a1,'c) t -> (('a0,'a1) tpl2,'c) ts
 val c9 : ('a0,'c) t -> ('a1,'c) t -> ('a2,'c) t -> ('a3,'c) t -> ('a4,'c) t -> ('a5,'c) t -> ('a6,'c) t -> ('a7,'c) t -> ('a8,'c) t -> (('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8) tpl9,'c) ts
 val c10 : ('a0,'c) t -> ('a1,'c) t -> ('a2,'c) t -> ('a3,'c) t -> ('a4,'c) t -> ('a5,'c) t -> ('a6,'c) t -> ('a7,'c) t -> ('a8,'c) t -> ('a9,'c) t -> (('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8,'a9) tpl10,'c) ts
 
+(** {6 Deconstruction of phantom hetero list} *)
+
 val d0 : (tpl0,'c) ts -> unit
 val d1 : ('a0 tpl1,'c) ts -> ('a0,'c) t
 val d2 : (('a0,'a1) tpl2,'c) ts -> ('a0,'c) t * ('a1,'c) t
 val get9 : (('a0 * ('a1 * ('a2 * ('a3 * ('a4 * ('a5 * ('a6 * ('a7 * ('a8 * ('a9 * _)))))))))),'c) ts -> ('a9,'c) t
 val get10 : (('a0 * ('a1 * ('a2 * ('a3 * ('a4 * ('a5 * ('a6 * ('a7 * ('a8 * ('a9 * ('a10 * _))))))))))),'c) ts -> ('a10,'c) t
 
+(** {6 Uncurry} *)
+
 val uncurry0 : (unit -> 'z) -> ((tpl0, 'c) ts -> 'z)
 val uncurry1 : (('a0,'c) t -> 'z) -> (('a0 tpl1, 'c) ts -> 'z)
 val uncurry2 : (('a0,'c) t -> ('a1,'c) t -> 'z) -> ((('a0,'a1) tpl2, 'c) ts -> 'z)
 val uncurry9 : (('a0,'c) t -> ('a1,'c) t -> ('a2,'c) t -> ('a3,'c) t -> ('a4,'c) t -> ('a5,'c) t -> ('a6,'c) t -> ('a7,'c) t -> ('a8,'c) t -> 'z) -> ((('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8) tpl9, 'c) ts -> 'z)
 val uncurry10 : (('a0,'c) t -> ('a1,'c) t -> ('a2,'c) t -> ('a3,'c) t -> ('a4,'c) t -> ('a5,'c) t -> ('a6,'c) t -> ('a7,'c) t -> ('a8,'c) t -> ('a9,'c) t -> 'z) -> ((('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8,'a9) tpl10, 'c) ts -> 'z)
 
+(** {6 Curry} *)
+
 val curry0 : ((tpl0,'c) ts -> 'z) -> unit -> 'z
 val curry1 : (('a0 tpl1,'c) ts -> 'z) -> (('a0,'c) t -> 'z)
 val curry2 : ((('a0,'a1) tpl2,'c) ts -> 'z) -> (('a0,'c) t -> ('a1,'c) t -> 'z)