Commits

camlspotter committed 1cf2a18

spotlib change

Comments (0)

Files changed (6)

   (** Arithmetic type conversion *)
 
   let sitofp ?(name="sitofped") i ty = 
-    unsafeM ^$ Llvm.build_sitofp !<i !<ty name
+    unsafeM & Llvm.build_sitofp !<i !<ty name
 
   (** Memory *)
 
   let alloca ?(name="inStack") ty =
-    unsafeM ^$ Llvm.build_alloca !<ty name
+    unsafeM & Llvm.build_alloca !<ty name
 
   (** Useful libc functions *)
 
 type 'a vs = ('a, GV.t) Phantom.ts
 
 let of_float : ([>`floating] as 'a) typ -> float -> 'a v = 
-  fun ty v -> P.unsafe ^$ GV.of_float !<ty v
+  fun ty v -> P.unsafe & GV.of_float !<ty v
 
 let unsafe_of_pointer : 'a (* unsafe *) -> 'b pointer v = 
-  fun v -> P.unsafe ^$ GV.of_pointer v
+  fun v -> P.unsafe & GV.of_pointer v
 
 let of_int32 : ([>`int] as 'a) typ -> int32 -> 'a v =
-  fun ty v -> P.unsafe ^$ GV.of_int32 !<ty v
+  fun ty v -> P.unsafe & GV.of_int32 !<ty v
 
 let of_int : ([>`int] as 'a) typ -> int -> 'a v =
-  fun ty v -> P.unsafe ^$ GV.of_int !<ty v
+  fun ty v -> P.unsafe & GV.of_int !<ty v
 
 let of_nativeint : ([>`int] as 'a) typ -> nativeint -> 'a v =
-  fun ty v -> P.unsafe ^$ GV.of_nativeint !<ty v
+  fun ty v -> P.unsafe & GV.of_nativeint !<ty v
 
 let of_int64 : ([>`int] as 'a) typ -> int64 -> 'a v =
-  fun ty v -> P.unsafe ^$ GV.of_int64 !<ty v
+  fun ty v -> P.unsafe & GV.of_int64 !<ty v
 
 let as_float : ([>`floating] as 'a) typ -> 'a v -> float = 
   fun ty v -> GV.as_float !<ty !<v
   
   module ExecutionEngine = struct
     let run_function (lv : ('args -> 'b) pointer v) (args : 'args Genvalue.vs) : 'b Genvalue.v = 
-      P.unsafe ^$ 
+      P.unsafe & 
         E.ExecutionEngine.run_function !<lv (P.List.to_array args) engine
     let run_function0 lv () = run_function lv P.c0
     let run_function1 lv a0 = run_function lv (P.c1 a0)
   let classify ty = classify_type !<ty
   let string_of ty = Extension.Llvm.string_of_lltype !defined_names !<ty
 
-  let i1 : i1 typ = P.unsafe ^$ i1_type context
-  let i8 : i8 typ = P.unsafe ^$ i8_type context
-  let i16 : i16 typ = P.unsafe ^$ i16_type context
-  let i32 : i32 typ = P.unsafe ^$ i32_type context 
-  let i64 : i64 typ = P.unsafe ^$ i64_type context
-  let integer ((_tag : 'itag), x) : 'itag integer typ = P.unsafe ^$ integer_type context x
+  let i1 : i1 typ = P.unsafe & i1_type context
+  let i8 : i8 typ = P.unsafe & i8_type context
+  let i16 : i16 typ = P.unsafe & i16_type context
+  let i32 : i32 typ = P.unsafe & i32_type context 
+  let i64 : i64 typ = P.unsafe & i64_type context
+  let integer ((_tag : 'itag), x) : 'itag integer typ = P.unsafe & integer_type context x
   let integer_bitwidth t = integer_bitwidth !<t
 
-  let float : float_ typ = P.unsafe ^$ float_type context 
-  let double : double typ = P.unsafe ^$ double_type context
-  let x86fp80 : x86fp80 typ = P.unsafe ^$ x86fp80_type context
-  let fp128 : fp128 typ = P.unsafe ^$ fp128_type context 
-  let ppc_fp128 : ppc_fp128 typ = P.unsafe ^$ ppc_fp128_type context
+  let float : float_ typ = P.unsafe & float_type context 
+  let double : double typ = P.unsafe & double_type context
+  let x86fp80 : x86fp80 typ = P.unsafe & x86fp80_type context
+  let fp128 : fp128 typ = P.unsafe & fp128_type context 
+  let ppc_fp128 : ppc_fp128 typ = P.unsafe & ppc_fp128_type context
 
   let function_ (ret : 'ret typ) (args : 'args typs) : ('args -> 'ret) typ =
-    P.unsafe ^$ function_type !<ret (P.List.to_array args)
+    P.unsafe & function_type !<ret (P.List.to_array args)
   let var_arg_function (ret : 'ret typ) (args : 'args typs) : ('args -> dots -> 'ret) typ = 
-    P.unsafe ^$ var_arg_function_type !<ret (P.List.to_array args)
+    P.unsafe & var_arg_function_type !<ret (P.List.to_array args)
   (* CR jfuruse: not for dots !*)
   let function_params (t : ('args -> 'ret) typ) : 'args typs = 
     P.List.unsafe_of_array (param_types !<t)
   let function_return (ty : ('args -> 'ret) typ) : 'ret typ = 
-    P.unsafe ^$ return_type !<ty
+    P.unsafe & return_type !<ty
 
   let struct_ (args : 'args typs) : 'args struct_ typ = 
-    P.unsafe ^$ struct_type context (P.List.to_array args)
+    P.unsafe & struct_type context (P.List.to_array args)
   let packed_struct (args : 'args typs) : 'args packed_struct typ =
-    P.unsafe ^$ packed_struct_type context (P.List.to_array args)
+    P.unsafe & packed_struct_type context (P.List.to_array args)
   let struct_elements (t : [>`members of 'typs] typ) : 'typs typs = 
     P.List.unsafe_of_array (struct_element_types !<t)
 
   let array_ (t : 't typ) ((_tag : 'itag), size) : ('t, 'itag) array_ typ = 
-    P.unsafe ^$ array_type !<t size
-  let pointer (t : 't typ) : 't pointer typ = P.unsafe ^$ pointer_type !<t
-  let qualified_pointer (t : 't typ) aspace : 't pointer typ = P.unsafe ^$ qualified_pointer_type !<t aspace
+    P.unsafe & array_type !<t size
+  let pointer (t : 't typ) : 't pointer typ = P.unsafe & pointer_type !<t
+  let qualified_pointer (t : 't typ) aspace : 't pointer typ = P.unsafe & qualified_pointer_type !<t aspace
   let vector (t : 't typ) ((_tag : 'itag), size) : ('t, 'itag) vector typ =
-    P.unsafe ^$ vector_type !<t size
-  let element (t : [>`container of 't] typ) : 't typ = P.unsafe ^$ element_type !<t
+    P.unsafe & vector_type !<t size
+  let element (t : [>`container of 't] typ) : 't typ = P.unsafe & element_type !<t
   let array_length (t : ('a, 'tag) array_ typ) = array_length !<t
   let address_space (t : 'a pointer typ) = address_space !<t
   let vector_size (t : ('a, 'tag) vector typ) = vector_size !<t
     let ty = f (P.unsafe op) in
     refine op ~by:(!<ty);
     ty
-  let void : void typ = P.unsafe ^$ void_type context
-  let label : label typ = P.unsafe ^$ label_type context
+  let void : void typ = P.unsafe & void_type context
+  let label : label typ = P.unsafe & label_type context
 
   (* void pointer is special in LLVM. It is illegal! *)
   let pointer_void = pointer i8
 let unsafe_annotate v (_t : 'ty typ) : 'ty v = P.unsafe v
 
 let dump v = dump_value !<v
-let type_of (v : 'typ v) = P.unsafe ^$ type_of !<v
+let type_of (v : 'typ v) = P.unsafe & type_of !<v
 let typs_of (ts : 'typs vs) : 'typs typs = 
   P.List.unsafe_of_list (List.map Llvm.type_of (P.List.to_list ts))
 let set_name name v = set_value_name name !<v

lib/value_ctxt.ml

   module Type = Type_ctxt.Make(A)
 
   module Const = struct
-    let int v : [`int] v = P.unsafe ^$ const_int (if Sys.word_size = 32 then !<Type.i32 else !<Type.i64) v
+    let int v : [`int] v = P.unsafe & const_int (if Sys.word_size = 32 then !<Type.i32 else !<Type.i64) v
     let nativeint n : [`int] v = 
-      P.unsafe ^$ const_of_int64 (if Sys.word_size = 32 then !<Type.i32 else !<Type.i64) (Int64.of_nativeint n) false
-    let i32 n : i32 v = P.unsafe ^$ const_of_int64 (!<Type.i32) (Int64.of_int32 n) false
-    let i32_of_int n : i32 v = P.unsafe ^$ const_of_int64 (!<Type.i32) (Int64.of_int n) false
+      P.unsafe & const_of_int64 (if Sys.word_size = 32 then !<Type.i32 else !<Type.i64) (Int64.of_nativeint n) false
+    let i32 n : i32 v = P.unsafe & const_of_int64 (!<Type.i32) (Int64.of_int32 n) false
+    let i32_of_int n : i32 v = P.unsafe & const_of_int64 (!<Type.i32) (Int64.of_int n) false
     let i32_0 = i32_of_int 0
     let i32_1 = i32_of_int 1
-    let i64 n : i64 v = P.unsafe ^$ const_of_int64 (!<Type.i64) n false
-    let double f : double v = P.unsafe ^$ const_float (!<Type.double) f
-    let bool b : i1 v = P.unsafe ^$ const_int (!<Type.i1) (if b then 1 else 0)
+    let i64 n : i64 v = P.unsafe & const_of_int64 (!<Type.i64) n false
+    let double f : double v = P.unsafe & const_float (!<Type.double) f
+    let bool b : i1 v = P.unsafe & const_int (!<Type.i1) (if b then 1 else 0)
   
-    let bitcast v (ty : 'typ typ) : 'typ v = P.unsafe ^$ const_bitcast !<v !<ty
-    let intcast (v : [>`int] v) (ty : ([>`int] as 'typ) typ) : 'typ v = P.unsafe ^$ const_intcast !<v !<ty
-    let ptrtoint (v : 'a pointer v) (ty : ([>`int] as 'typ) typ) : 'typ v = P.unsafe ^$ const_ptrtoint !<v !<ty
-    let null (ty : 'typ typ) : 'typ v = P.unsafe ^$ const_null !<ty
+    let bitcast v (ty : 'typ typ) : 'typ v = P.unsafe & const_bitcast !<v !<ty
+    let intcast (v : [>`int] v) (ty : ([>`int] as 'typ) typ) : 'typ v = P.unsafe & const_intcast !<v !<ty
+    let ptrtoint (v : 'a pointer v) (ty : ([>`int] as 'typ) typ) : 'typ v = P.unsafe & const_ptrtoint !<v !<ty
+    let null (ty : 'typ typ) : 'typ v = P.unsafe & const_null !<ty
   
     let unsafe_gep v ints = 
-      P.unsafe ^$ const_gep !<v (Array.of_list (List.map (fun x -> !<(i32_of_int x)) ints))
+      P.unsafe & const_gep !<v (Array.of_list (List.map (fun x -> !<(i32_of_int x)) ints))
 
     let gep_gen cont v = Gep.gen (fun lst ->
         let lst = List.map (function
   end
   
   (* CR: size of is defined here, where value is available *)
-  let size_i64_of ty : i64 v = P.unsafe ^$ Llvm.size_of !<ty
+  let size_i64_of ty : i64 v = P.unsafe & Llvm.size_of !<ty
   let size_of ty : i32 v = Const.intcast (size_i64_of ty) Type.i32
 
   module Analysis = struct