Commits

camlspotter committed 55c5eb9

comments and array

Comments (0)

Files changed (10)

     and type 'a struct_ = 'a struct_
     and type 'a pointer = 'a pointer
     and type 'a vector = 'a vector
+    and type ('a, 'b) array_ = ('a, 'b) array_
     and type void_pointer = void_pointer
     and module Tagged = Ltype.Base.Tagged
     and module WithString = Ltype.Base.WithString
 open Lvalue.Base
 
 module type S = sig
+
+  (** Monad for builder *)    
   module Monad : sig
     include Monad_intf.T with type 'a t = Llvm.llbuilder -> 'a
     val run : 'a t -> 'a
   end
   type 'a m = 'a Monad.t
 
+  (** Lifted value coercions *)      
   val unknownM : 'a v m -> unknown v m
   val magicM : 'a v m -> 'b v m
 
   val fcmp : Llvm.Fcmp.t -> ?name:string -> ([>`floating] as 'a) v -> 'a v -> bool v m
 
   val printf : string -> unknown v list -> unit m
+    (* CR jfuruse: probably (quite unlikely though), we can have a type safer version *)
 
   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
 
   val malloc : ?name:string -> ?bzero:bool -> i32 v -> void_pointer v m
+    (** malloc by size. *)
+
   val malloc_by_ty : ?name:string -> ?bzero:bool -> 'a typ -> 'a pointer v m
+    (** 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 : void_pointer v -> unit m
+
   val unsafe_const_load : ?name:string -> 'a pointer v -> int list -> 'unsafe v m
   val unsafe_const_store : 'a pointer v -> int list -> 'unsafe v -> unit m
 
   val if_then_else : bool v m -> 'a v m -> 'a v m -> 'a v m
 
   val exec : unit m -> unit
+    (** [exec u] creates an anonymous function from [u] and runs it. *)
 end
   val opt : bool
 
   val module_ : Llvm.llmodule
+
+  val define_type_name : string -> 'a typ -> 'a typ
+  val dump : Llvm.llmodule -> unit
+
   module ExecutionEngine : sig
     (* CR: can be more type safe *)
     val run_function : ('args -> 'ret) pointer v -> GenericValue.t array -> GenericValue.t
   end
-  val define_type_name : string -> 'a typ -> 'a typ
-  val dump : Llvm.llmodule -> unit
-  
+
   module Function : sig
     val lookup : string -> (unknown -> unknown) pointer t option
     val declare : string -> ('a -> 'b) typ -> ('a -> 'b) pointer v
     val printf : ((i8 pointer -> dots -> i32) pointer) v
     val bzero : (((void_pointer * i32) -> void) pointer) v
   end
+
   module PassManager : sig 
     val run_function_if_opt : ('a -> 'b) pointer v -> unit 
   end
   type double = [`floating | `double]
   type dots
   type 'a struct_
-  (* type ('a, 'tag) array *)
-  type 'a pointer = [`pointer of 'a]
-  type 'a vector
+  type ('a, 'tag) array_ = [`array of 'a * 'tag | `container of 'a]
+  type 'a pointer = [`pointer of 'a | `container of 'a]
+  type 'a vector = [`vector of 'a | `container of 'a]
   
   (* void pointer is special in LLVM. It is illegal! *)
   type void_pointer = i8 pointer
     let ty = f op in
     refine op ~by:ty;
     ty
-
 end
   and type 'a struct_ = 'a struct_
   and type 'a pointer = 'a pointer
   and type 'a vector = 'a vector
+  and type ('a, 'b) array_ = ('a, 'b) array_
   and type void_pointer = void_pointer
   and module Tagged = Base.Tagged
   and module WithString = Base.WithString
   type double = [`floating | `double]
   type dots
   type 'a struct_
-  (* type ('a, 'b) array_ *) (* use OCaml's array *)
-  type 'a pointer = [`pointer of 'a]  
+  type ('a, 'b) array_ = [`array of 'a * 'b | `container of 'a] (* use OCaml's array *)
+  type 'a pointer = [`pointer of 'a | `container of 'a]  
     (* The definition is to permit recursive definition like:
        type t = (i32 * t pointer) struct_
     *)
-  type 'a vector
+  type 'a vector = [`vector of 'a | `container of 'a]
   (* void pointer is special in LLVM. It is illegal! *)
   type void_pointer = i8 pointer
 
   val var_arg_function : 'ret typ -> 'args typs -> ('args -> dots -> 'ret) typ
   val function_params : ('args -> 'ret) typ -> 'args typs
   val function_return : ('args -> 'ret) typ -> 'ret typ
-  (* function_ is prefixed to avoid the name clash with Monad.return *)
+    (* function_ is prefixed to avoid the name clash with Monad.return *)
   val struct_ : 'args typs -> 'args struct_ typ
-  val check_struct : unknown typ -> unknown struct_ typ
+  val check_struct : 'a typ -> unknown struct_ typ
+    (** may raise Assert_failure *)
+
   val struct_elements : 'args struct_ typ -> 'args typs
   val array : 'a typ -> 'tag * int -> ('a * 'tag) array typ
   val pointer : 'a typ -> 'a pointer typ
   val check_pointer : 'a typ -> 'a pointer typ
-  val element : 'a pointer typ -> 'a typ
+    (** may raise Assert_failure *)
+
+  val element : [>`container of 'a] typ -> 'a typ
 
   val define_name : modname: string -> string -> 'a typ -> unit
   val string_of : 'a typ -> string
 
   val recursive : ('a typ -> 'b typ) -> 'b typ
     (** [recursive f] returns a recusive type defined by [f] *)
+
+  (* size_of requires Lvalue.v, so defined in Lvalue.
+     val size_of : 'a typ -> i32 v
+  *)
 end 
   let (!=<) = (!<)
   let (!=>) = (!>)
   let (!=?) = (!?)
-  let wrap v _t = v
+  let unsafe_annotate v _t = v
   
   let dump = dump_value
   let type_of v = Obj.magic (type_of v) (* !! *)
+  let typs_of (ts : 'typs ts) : 'typs Ltype.Base.typs =
+    Ltype.Base.of_list
+      (List.map (fun llvalue -> Ltype.Base.unsafe (Llvm.type_of llvalue))
+         (to_list ts))
   let set_name = set_value_name
   let name = value_name
   
   let size_i64_of ty : Ltype.i64 t = Llvm.size_of !:<ty
   let size_of ty = Const.intcast (size_i64_of ty) Ltype.i32
 
-  let typs_of (ts : 'typs ts) : 'typs Ltype.typs =
-    Ltype.of_list
-      (List.map (fun llvalue -> Ltype.unsafe (Llvm.type_of llvalue))
-         (to_list ts))
-
   module Analysis = struct
     let assert_valid_function (v : ('a -> 'b) Ltype.pointer v) = Llvm_analysis.assert_valid_function !=<v
   end
   type 'a v = 'a t
   type 'a vs = 'a ts
 
+  (** safe/unsafe coercions. Begin with "!=". ("!:" is for type coercions.) *)
   val ( !=< ) : 'a v -> Llvm.llvalue
+    (** Coerce down to [llvalue] *)
   val ( !=? ) : 'a v -> unknown v
+    (** Forget the type info *)
   val ( !=> ) : Llvm.llvalue -> unknown v
-  val wrap : Llvm.llvalue -> 'ty typ -> 'ty v 
+    (** Lift up to [unknown v] *)
+  val unsafe_annotate : Llvm.llvalue -> 'ty typ -> 'ty v 
+    (** annotate a type, but unsafe *)
 
   val dump : 'ty v -> unit
   val type_of : 'ty v -> 'ty typ
+  val typs_of : 'tys vs -> 'tys typs
   val set_name : string -> 'ty v -> unit
   val name : 'ty v -> string
   val function_params : ('args -> 'ret) pointer v -> 'args vs
     val double : float -> double v
     val bool : bool -> i1 v
     val bitcast : 'a v -> 'ty typ -> 'ty v
-    val intcast : 'a v -> 'ty typ -> 'ty v
-    val ptrtoint : 'a pointer v -> 'ty typ -> 'ty v
+    val intcast : [>`int] v -> ([>`int] as 'a) typ -> 'a v
+    val ptrtoint : 'a pointer v -> ([>`int] as 'a) typ -> 'a v
     val null : 'ty typ -> 'ty v
-      (* Note that it can take non pointer type! *)
+      (* [null ty] returns a null value of type [ty]. 
+         Note that it can take non pointer type. 
+         It does NOT create a null pointer for [ty pointer]! *)
     val unsafe_gep : 'a pointer v -> int list -> 'unsafe pointer v
   end
   
-  val size_i64_of : 'a typ -> i64 v 
-  val size_of : 'a typ -> i32 v 
-
-  val typs_of : 'tys ts -> 'tys typs
-
   module Analysis : sig 
     val assert_valid_function : ('a -> 'b) pointer v -> unit 
   end
+
+  val size_i64_of : 'a typ -> i64 v 
+  val size_of : 'a typ -> i32 v 
 end 
 
 
     and type 'a struct_ = 'a struct_
     and type 'a pointer = 'a pointer
     and type 'a vector = 'a vector
+    and type ('a, 'b) array_ = ('a, 'b) array_
     and type void_pointer = void_pointer
     and module Tagged = Tagged
     and module WithString = WithString
     and type 'a struct_ = 'a struct_
     and type 'a pointer = 'a pointer
     and type 'a vector = 'a vector
+    and type ('a, 'b) array_ = ('a, 'b) array_
     and type void_pointer = void_pointer
     and module Tagged = Tagged
     and module WithString = WithString