Commits

Jacques-Pascal Deplaix committed 112fa8c

Move the function that prints types from LLVM to LLVM_types and transform the types

Comments (0)

Files changed (4)

   | `Dllexport
   ]
 
-type data_type =
-  | Int of int
-  | Array of int * data_type
-  | Pointer of data_type
-  | Pointer_function of data_type array * data_type
-
 type address =
   | Addrspace of int
   | Unnamed_addr
   | Initialexec
   | Localexec
 
-type context_module =
+type 'a context_module =
   | Global of
     (string * thread_local option *
     address * link_type option * bool *
-    data_type * string option * int option)
+    'a LLVM_types.t * string option * int option)
   | Declaration of
-    (data_type * string * data_type array *
+    ('a LLVM_types.t * string * 'a LLVM_types.t array *
     [`External | `Dllimport | `Extern_weak ] option)
 
 
   | `Dllimport               -> "dllimport"
   | `Dllexport               -> "dllexport"
 
-let rec string_of_data_type ?f:(name = "") data =
-  let rec aux acc arr = function
-    | 0 -> acc
-    | n -> aux (acc ^ ", " ^ (string_of_data_type arr.(n))) arr (n - 1)
-  in match data with
-  | Int i                   -> "i" ^ (string_of_int i)
-  | Pointer t               -> string_of_data_type t ^ "*"
-  | Array (i, t) ->
-    "[" ^ (string_of_int i) ^ " x " ^ (string_of_data_type t) ^ "]"
-  | Pointer_function (a, t) ->
-    (string_of_data_type t) ^ " @" ^ name ^ "("
-    ^ (aux (if Array.length a > 0 then (string_of_data_type a.(0)) else "") a
-      (Array.length a - 1))
-    ^ ") *"
-
 let string_of_address = function
   | Addrspace i             -> "addr(" ^ (string_of_int i) ^ ")"
   | Unnamed_addr            -> "unnamed_addr"
   in let string_constant = match constant with
     | true                  -> " constant"
     | false                 -> ""
-  in let string_data_type = " " ^ (string_of_data_type data_type)
+  in let string_data_type = " " ^ (LLVM_types.to_string data_type)
   in let string_section = match section with
     | None                  -> ""
     | Some a                -> ", section \"" ^ a ^ "\""
   (type_return, id, type_arguments, link_type) =
   let rec aux acc arr = function
     | 0 -> acc
-    | n -> aux (acc ^ ", " ^ (string_of_data_type arr.(n))) arr (n - 1)
-  in let string_type_return = (string_of_data_type type_return)
+    | n -> aux (acc ^ ", " ^ (LLVM_types.to_string arr.(n))) arr (n - 1)
+  in let string_type_return = (LLVM_types.to_string type_return)
   in let string_type_arguments =
     aux (if Array.length type_arguments > 0
-      then (string_of_data_type type_arguments.(0))
+      then (LLVM_types.to_string type_arguments.(0))
       else "") type_arguments (Array.length type_arguments - 1)
   in let string_link_type = match link_type with
     | None                  -> ""
   | `Dllexport
   ]
 
-type data_type =
-  | Int of int
-  | Array of int * data_type
-  | Pointer of data_type
-  | Pointer_function of data_type array * data_type
-
 type address =
   | Addrspace of int
   | Unnamed_addr
   | Initialexec
   | Localexec
 
-type context_module =
+type 'a context_module =
   | Global of
     (string * thread_local option *
     address * link_type option * bool *
-    data_type * string option * int option)
+    'a LLVM_types.t * string option * int option)
   | Declaration of
-    (data_type * string * data_type array *
+    ('a LLVM_types.t * string * 'a LLVM_types.t array *
     [`External | `Dllimport | `Extern_weak ] option)
 
 (*
   ?constant: bool ->
   ?section: string option ->
   ?alignment: int option ->
-  string -> data_type -> context_module
+  string -> 'a LLVM_types.t -> 'a context_module
 
 val new_declaration:
   ?link_type: [< `External | `Dllimport | `Extern_weak ] option ->
-  data_type -> string -> data_type array -> context_module
+  'a LLVM_types.t -> string -> 'a LLVM_types.t array -> 'a context_module
 
-val print_context_module: context_module -> unit
+val print_context_module:
+  ([< 'a LLVM_types.llvm_array
+   | ('a, 'a) LLVM_types.llvm_function_pointer
+   | LLVM_types.llvm_int
+   | 'a LLVM_types.llvm_pointer
+   ] as 'a) context_module ->
+  unit
 let array i x = {data = `Array (i, x)}
 let pointer t x = {data = `Pointer (t, x)}
 let function_pointer params return_type x = {data = `Function_pointer (params, return_type, x)}
+
+let rec to_string data =
+  let rec aux acc arr = function
+    | 0 -> acc
+    | n -> aux (acc ^ ", " ^ to_string arr.(n)) arr (pred n)
+  in
+  match data with
+    | `Int (i, _) -> "i" ^ string_of_int i
+    | `Pointer (t, _) -> to_string t ^ "*"
+    | `Array (i, t) ->
+        "[" ^ string_of_int i ^ " x " ^ to_string t ^ "]"
+    | `Function_pointer (a, t, _) ->
+        to_string t ^ " @("
+        ^ aux
+          (if Array.length a > 0 then to_string a.(0) else "")
+          a
+          (Array.length a - 1)
+        ^ ") *"
+
+let to_string data = to_string data.data
 val array : int -> 'a -> 'a llvm_array t
 val pointer : 'a -> int option -> 'a llvm_pointer t
 val function_pointer : 'a array -> 'b -> int option -> ('a, 'b) llvm_function_pointer t
+
+val to_string :
+  ([< llvm_int
+   | 'a llvm_array
+   | 'a llvm_pointer
+   | ('a, 'a) llvm_function_pointer
+   ] as 'a) t ->
+  string