TyLLVM / LLVM.ml

type link_type = [
  | `Private
  | `Linker_private
  | `Linker_private_weak
  | `Internal
  | `Available_externally
  | `Linkonce
  | `Weak
  | `Common
  | `Appending
  | `Extern_weak
  | `Linkonce_odr
  | `Weak_odr
  | `Linkonce_odr_auto_hide
  | `External
  | `Dllimport
  | `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
  | None_addr

type thread_local =
  | Localdynamic
  | Initialexec
  | Localexec

type calling_convention =
  | CCC
  | FastCC
  | ColdCC
  | CC of int

type visibility =
  | Default
  | Hidden
  | Protected

type function_attribute =
  | Alignstack of int
  | Alwaysinline
  | Cold
  | Nonlazybind
  | Inlinehint
  | Naked
  | Nobuiltin
  | Noduplicate
  | Noimplicitefloat
  | Noinline
  | Noredzone
  | Noreturn
  | Nounwind
  | Optsize
  | Readnone
  | Readonly
  | Returns_twice
  | Sanitize_address
  | Sanitize_memory
  | Sanitize_thread
  | Ssp
  | Sspreq
  | Sspstrong
  | Uwtable

type instr =
  | Ret

type context_module =
  | Global of
    (string * thread_local option *
    address * link_type option * bool *
    data_type * string option * int option)
  | Declaration of
    (data_type * string * data_type array *
    [`External | `Dllimport | `Extern_weak ] option)
  | Definition of
    ((data_type * string * data_type array) * instr list)

let string_of_link_type = function
  | `Private                -> "private"
  | `Linker_private         -> "linker_private"
  | `Linker_private_weak    -> "linker_private_weak"
  | `Internal               -> "internal"
  | `Available_externally   -> "available_externally"
  | `Linkonce               -> "linkonce"
  | `Weak                   -> "weak"
  | `Common                 -> "common"
  | `Appending              -> "appending"
  | `Extern_weak            -> "extern_weak"
  | `Linkonce_odr           -> "linkonce_odr"
  | `Weak_odr               -> "weak_odr"
  | `Linkonce_odr_auto_hide -> "linkonce_odr_auto_hide"
  | `External               -> "external"
  | `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_instr = function
  | Ret                     -> "\tret"

let string_of_address = function
  | Addrspace i             -> "addr(" ^ (string_of_int i) ^ ")"
  | Unnamed_addr            -> "unnamed_addr"
  | None_addr               -> ""

let string_of_thread_local = function
  | Localdynamic            -> "thread_local(localdynamic)"
  | Initialexec             -> "thread_local(initialexec)"
  | Localexec               -> "thread_local(localexec)"

let string_of_global
  (id, thread_local, address, link_type, constant, data_type, section, align) =
  let string_thread_local = match thread_local with
    | None                  -> ""
    | Some a                -> " " ^ (string_of_thread_local a)
  in let string_address = match string_of_address address with
    | ""                    -> ""
    | a                     -> " " ^ a
  in let string_link_type = match link_type with
    | None                  -> ""
    | Some a                -> " " ^ (string_of_link_type a)
  in let string_constant = match constant with
    | true                  -> " constant"
    | false                 -> ""
  in let string_data_type = " " ^ (string_of_data_type data_type)
  in let string_section = match section with
    | None                  -> ""
    | Some a                -> ", section \"" ^ a ^ "\""
  in let string_align = match align with
    | None                  -> ""
    | Some a                -> ", align " ^ (string_of_int a)
  in "@" ^ id ^ " =" ^ string_thread_local ^ string_address ^ string_link_type
  ^ string_constant ^ string_data_type ^ string_section ^ string_align

let string_of_declaration
  (type_return, id, type_arguments, link_type) =
  let rec aux acc arr n =
    if n <= 0 then acc
    else aux (acc ^ ", " ^ (string_of_data_type arr.(n))) arr (n - 1)
  in let string_type_return = (string_of_data_type type_return)
  in let string_type_arguments =
    aux (if Array.length type_arguments > 0
      then (string_of_data_type type_arguments.(0))
      else "") type_arguments (Array.length type_arguments - 1)
  in let string_link_type = match link_type with
    | None                  -> ""
    | Some a                -> " " ^ (string_of_link_type a)
  in "declare " ^ string_type_return ^ " @" ^ id
  ^ "(" ^ string_type_arguments ^ ")" ^ string_link_type

let string_of_definition
  ((type_return, id, type_arguments), instr_list) =
  let rec aux acc arr n =
    if n <= 0 then acc
    else aux (acc ^ ", " ^ (string_of_data_type arr.(n))) arr (n - 1)
  in let string_type_return = (string_of_data_type type_return)
  in let string_type_arguments =
    aux (if Array.length type_arguments > 0
      then (string_of_data_type type_arguments.(0))
      else "") type_arguments (Array.length type_arguments - 1)
  in let string_instr_list =
    List.fold_left (fun a x -> a ^ (string_of_instr x) ^ "\n") "" instr_list
  in "define " ^ string_type_return ^ " @" ^ id
  ^ "(" ^ string_type_arguments ^ ")" ^ " {\n" ^ string_instr_list ^ "}"

let print_global a = print_string (string_of_global a)

let new_global
  ?(thread_local=None)
  ?(address=None_addr)
  ?(link_type=None)
  ?(constant=false)
  ?(section=None)
  ?(alignment=None)
  id data_type =
  Global (id, thread_local, address, link_type,
    constant, data_type, section, alignment)

let print_declaration a = print_string (string_of_declaration a)

let new_declaration
  ?(link_type=None) type_return id type_arguments =
  Declaration (type_return, id, type_arguments,
    (link_type :> [ `External | `Dllimport | `Extern_weak] option))

let print_definition a = print_string (string_of_definition a)

let new_definition
  type_return id type_arguments instr_list =
  Definition ((type_return, id, type_arguments), instr_list)

let print_context_module e =
  let aux = function
    | Global a              -> print_global a
    | Declaration a         -> print_declaration a
    | Definition a          -> print_definition a
  in aux e; print_newline ()
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.