Commits

camlspotter  committed c2782a5

cleanup and bool => i1

  • Participants
  • Parent commits 89dac8c

Comments (0)

Files changed (6)

     unsafeM (Llvm.build_phi (List.map (fun (v, b) -> !=<v, b) lst) name)
 
   let cond_br 
-      (b : bool v)
+      (b : i1 v)
       bthen belse
       : unit m
       = Monad.ignore (Llvm.build_cond_br !=<b bthen belse)
 
   let br b = Monad.ignore (Llvm.build_br b)
 
-  let is_null ?(name="is_null") (lv : 'a pointer v) : bool v m = 
+  let is_null ?(name="is_null") (lv : 'a pointer v) : i1 v m = 
     unsafeM (Llvm.build_is_null !=<lv name)
 
   (* CR jfuruse: unfortunately no arith type check is done yet *)      
       (unsafeM (f !=<x !=<y name) : 'a v m)
   let cmp (defname : string) f = 
     fun ?(name=defname) (x : 'a v) (y : 'a v) ->
-      (unsafeM (f !=<x !=<y name) : bool v m)
+      (unsafeM (f !=<x !=<y name) : i1 v m)
 
   let add  ?name = arith "added" Llvm.build_add ?name
   let sub  ?name = arith "subed" Llvm.build_sub ?name
     let parent bb : ('a -> 'b) pointer t = Value.unsafe (Llvm.block_parent bb)
   end
 
-  let func name (lty_return : 'ret typ) (args : 'args Ltype.Base.WithString.ts) f : ('args -> 'ret) pointer v m =
+  let func name (ty_ret : 'ret typ) (args : 'args Ltype.Base.WithString.ts) (f : 'args vs -> 'ret v m) : ('args -> 'ret) pointer v m =
     Format.eprintf "Creating function %s@." name;
-    let lty = function_ lty_return (Ltype.Base.WithString.types args) in
+    let lty = function_ ty_ret (Ltype.Base.WithString.types args) in
     let lv_f = match Module.Function.lookup name with
       | Some _ -> failwithf "LLib.create_fun: function %s is defined more than once" name
       | None -> Module.Function.declare name lty
       Block.position_at_end bb;
       lv_body <-- f (function_params lv_f);
       (* Finish off the function. *)
-      if classify lty_return = Llvm.TypeKind.Void then ret_void else ret lv_body;
+      if classify ty_ret = Llvm.TypeKind.Void then ret_void else ret lv_body;
       (* Validate the generated code, checking for consistency. *)
       \ Value.dump lv_f;
       \ Analysis.assert_valid_function lv_f;
       \ Module.PassManager.run_function_if_opt lv_f;
       \  Format.eprintf "Created function %s@." name;
       return lv_f
-        
+
   let return_void : void v m = (fun _builder -> magic Const.i32_0)
     (* The return value looks strange but probably ok. Probably. *)
 
-  let if_then_else (f_lv_cond : bool v m) (f_lv_then : 'a v m) (f_lv_else : 'a v m) : 'a v m = perform
+  let if_then_else (f_lv_cond : i1 v m) (f_lv_then : 'a v m) (f_lv_else : 'a v m) : 'a v m = perform
     (* get the current bb *)
     start_bb <-- Block.insertion;
     (* get the function being defined *)

File lbuilder_intf.ml

     
   val phi : ?name:string -> ('a v * Llvm.llbasicblock) list -> 'a v m
 
-  val cond_br : bool v -> Llvm.llbasicblock -> Llvm.llbasicblock -> unit m
+  val cond_br : i1 v -> Llvm.llbasicblock -> Llvm.llbasicblock -> unit m
 
   val br : Llvm.llbasicblock -> unit m
 
-  val is_null : ?name:string -> 'a pointer v -> bool v m
+  val is_null : ?name:string -> 'a pointer v -> i1 v m
 
   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 fsub : ?name:string -> ([>`floating] as 'a) v -> 'a v -> 'a v m
   val fmul : ?name:string -> ([>`floating] as 'a) v -> 'a v -> 'a v m
   val fdiv : ?name:string -> ([>`floating] as 'a) v -> 'a v -> 'a v m
-  val icmp : Llvm.Icmp.t -> ?name:string -> ([>`int] as 'a) v -> 'a v -> bool v m
-  val fcmp : Llvm.Fcmp.t -> ?name:string -> ([>`floating] as 'a) v -> 'a v -> bool v m
+  val icmp : Llvm.Icmp.t -> ?name:string -> ([>`int] as 'a) v -> 'a v -> i1 v m
+  val fcmp : Llvm.Fcmp.t -> ?name:string -> ([>`floating] as 'a) v -> 'a v -> i1 v m
 
   val printf : string -> unknown v list -> unit m
     (* CR jfuruse: probably (quite unlikely though), we can have a type safer version *)
   val return_void : void v m 
     (** for functions returning void *)
 
-  val if_then_else : bool v m -> 'a v m -> 'a v m -> 'a v m
+  val if_then_else : i1 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. *)

File lgenvalue.ml

+open Spotlib.Spot
 open Llvm
 open Llvm_executionengine
 open Ltype.Base

File lgenvalue.mli

+open Spotlib.Spot
 open Ltype.Base
 open Llvm_executionengine
 
   module Tagged(Tag : sig type t end) = struct
     let base_unsafe = unsafe
     let base_to_list = to_list
-    let base_of_list = of_list
+    let base_unsafe_of_list = unsafe_of_list
 
     type tag = Tag.t
     include Spotlib.Spot.Phantom.Make(struct 
   
     let tags ts = List.map fst (to_list ts)
     let types (ts : 'a ts) : 'a typs = 
-      base_of_list (List.map (fun (_,ty) -> base_unsafe ty) (to_list ts))
+      base_unsafe_of_list (List.map (fun (_,ty) -> base_unsafe ty) (to_list ts))
     let combine tags (ts : 'a typs) : 'a ts =
-      of_list (List.map unsafe (List.combine tags (base_to_list ts)))
+      unsafe_of_list (List.map unsafe (List.combine tags (base_to_list ts)))
     let tag t v = (t, v)
   end
   
   let double = double_type
   let function_ ret args = function_type ret (to_array args)
   let var_arg_function ret args = var_arg_function_type ret (to_array args)
-  let function_params t = of_array (param_types t)
+  let function_params (t : ('args -> 'ret) typ) : 'args typs = unsafe_of_array (param_types t)
   let function_return = return_type
   let struct_ c args = struct_type c (Array.of_list (to_list args))
   let check_struct t = match classify t with
     | TypeKind.Struct -> t
     | _ -> assert false
   
-  let struct_elements t = of_array (struct_element_types t)
+  let struct_elements (t : 'typs struct_ typ) : 'typs typs = unsafe_of_array (struct_element_types t)
   let array t (_tag, size) = array_type t size
     
   let pointer = pointer_type
   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))
+    Ltype.Base.unsafe_of_list (List.map Llvm.type_of (to_list ts))
   let set_name = set_value_name
   let name = value_name