Commits

Calascibetta Romain committed 4d75ddc

Add getelementptr in expr

  • Participants
  • Parent commits 09744b9

Comments (0)

Files changed (2)

   | `Returned
   ]
 
-type variable =
-  | VGlobal of string
-  | VLocal of string
+type 'a expr =
+  | Call of (bool * calling_convention option *
+    [`Zeroext | `Signext | `Inreg ] option * 'a LLVM_types.t *
+    'a expr * ('a expr list))
+  | Variable_global of string
+  | Variable_local of string
+  | Assign of (string * 'a expr)
+  | GetElementPtr of (bool * 'a LLVM_types.t * 'a expr *
+    'a LLVM_types.value list)
 
 type 'a instr =
   | Ret of 'a LLVM_types.value
-  | Call of (bool * calling_convention option *
-    [`Zeroext | `Signext | `Inreg ] option * 'a LLVM_types.t *
-    variable * ('a instr list))
+  | Expr of 'a expr
 
 type ('a, 'b, 'c) context_module =
   | Global of
   | Definition of
     (('a LLVM_types.t * string * 'b LLVM_types.t array) * 'c instr list)
 
-let string_of_variable : variable -> string = function
-  | VGlobal s               -> "@" ^ s
-  | VLocal s                -> "%" ^ s
-
 let string_of_link_type = function
   | `Private                -> "private"
   | `Linker_private         -> "linker_private"
   | ColdCC                  -> "coldcc"
   | CC i                    -> "cc " ^ (string_of_int i)
 
-let rec string_of_instr a =
+let rec string_of_expr a = 
   let rec aux acc = function
     | [] -> acc
-    | x :: r -> aux (acc ^ ", " ^ (string_of_instr x)) r
+    | x :: r -> aux (acc ^ ", " ^ (string_of_expr x)) r
   in match a with
-    | Ret a                   -> "\tret " ^ (LLVM_types.value_to_string a)
+    | Variable_global s     -> "@" ^ s
+    | Variable_local s      -> "%" ^ s
+    | Assign (s, v)         -> "%" ^ s ^ " = " ^
+      (string_of_expr v)
     | Call (tail, cconv, ret_attr, ret_type, name, arguments) ->
-        let tail_string = if tail = true then "tail " else "" in
-        let cconv_string = match cconv with
-          | Some a -> " " ^ (string_of_calling_conventation a)
-          | None -> ""
-        in let ret_attr_string = match ret_attr with
-          | Some a -> " " ^ (string_of_parameter_attribute a)
-          | None -> ""
-        in let ret_type_string = " " ^ (LLVM_types.to_string ret_type)
-        in let name_string = " " ^ (string_of_variable name)
-        in let arguments_string = match arguments with
-          | [] -> ""
-          | x :: r -> aux (string_of_instr x) r
-        in "\t" ^ tail_string ^ "call" ^ cconv_string ^ ret_attr_string ^
-        ret_type_string ^ name_string ^ "(" ^ arguments_string ^ ")"
+      let tail_string = if tail = true then "tail " else "" in
+      let cconv_string = match cconv with
+        | Some a -> " " ^ (string_of_calling_conventation a)
+        | None -> ""
+      in let ret_attr_string = match ret_attr with
+        | Some a -> " " ^ (string_of_parameter_attribute a)
+        | None -> ""
+      in let ret_type_string = " " ^ (LLVM_types.to_string ret_type)
+      in let name_string = " " ^ (string_of_expr name)
+      in let arguments_string = match arguments with
+        | [] -> ""
+        | x :: r -> aux (string_of_expr x) r
+      in tail_string ^ "call" ^ cconv_string ^ ret_attr_string ^
+      ret_type_string ^ name_string ^ "(" ^ arguments_string ^ ")"
+    | GetElementPtr (inbounds, ptr_type, ptr, list_id) ->
+      let inbounds_string = if inbounds then " inbounds" else "" in
+      let ptr_type_string = " " ^ (LLVM_types.to_string ptr_type) in
+      let ptr_string = " " ^ (string_of_expr ptr) in
+      let list_id_string = List.fold_left
+        (fun a v -> a ^ ", " ^ (LLVM_types.value_to_string v))
+        "" list_id
+      in "getelementptr" ^ inbounds_string ^ ptr_type_string ^
+      ptr_string ^ list_id_string
+
+let string_of_instr = function
+  | Ret a                   -> "\tret " ^ (LLVM_types.value_to_string a)
+  | Expr a                  -> "\t" ^ (string_of_expr a)
 
 let string_of_address = function
   | Addrspace i             -> "addr(" ^ (string_of_int i) ^ ")"
   Call (tail, cconv, (ret_attr :> [ `Zeroext | `Signext | `Inreg ] option),
     ret_type, name, arguments)
 
+let getelementptr
+  ?(inbounds=false)
+  ptr_type ptr list_id =
+  GetElementPtr (inbounds, ptr_type, ptr, list_id)
+
 let print_global a = print_string (string_of_global a)
 
 let new_global
   | `Returned
   ]
 
-type variable =
-  | VGlobal of string
-  | VLocal of string
+type 'a expr =
+  | Call of (bool * calling_convention option *
+    [`Zeroext | `Signext | `Inreg ] option * 'a LLVM_types.t *
+    'a expr * ('a expr list))
+  | Variable_global of string
+  | Variable_local of string
+  | Assign of (string * 'a expr)
+  | GetElementPtr of (bool * 'a LLVM_types.t * 'a expr *
+    'a LLVM_types.value list)
 
 type 'a instr =
   | Ret of 'a LLVM_types.value
-  | Call of (bool * calling_convention option *
-    [`Zeroext | `Signext | `Inreg ] option * 'a LLVM_types.t *
-    variable * ('a instr list))
+  | Expr of 'a expr
 
 type ('a, 'b, 'c) context_module =
   | Global of
   ?tail: bool ->
   ?cconv: calling_convention option ->
   ?ret_attr: [< `Zeroext | `Signext | `Inreg ] option ->
-  'a LLVM_types.t -> variable -> 'a instr list -> 'a instr
+  'a LLVM_types.t -> 'a expr -> 'a expr list -> 'a expr
+
+val getelementptr:
+  ?inbounds: bool ->
+  'a LLVM_types.t -> 'a expr -> 'a LLVM_types.value list -> 'a expr
 
 val new_global:
   ?thread_local:thread_local option ->