Source

ocaml-llvm-phantom / lib / build_intf.ml

Full commit
open Spotlib.Spot
open Phantom
open Type
open Value
open Llvm

module type S = sig

  (** {5 Builder monad}

      In Llvm.mli, llbuilder is a handle which is required almost of all the building functions.
      This is just a state so we introduce a monad to apply it implicitly.
  *)

  module Monad : sig
    include Monad_intf.T with type 'a t = llbuilder -> 'a
    val run : 'a t -> 'a
  end
  type 'a m = 'a Monad.t

  val build : 'a m -> 'a
  (** [build m] runs the code gen stored in the monad [m] *)

  (** {6 Lifted value coercions } *)

  val unknownM : 'a v m -> unknown v m
  val magicM : 'a v m -> 'b v m

  (** {6 Function calls} *)

  val call : ?name:string -> ('a -> 'b) pointer v -> 'a vs -> 'b v m
  val call_va_args : ?name: string -> ('a -> dots -> 'b) pointer v -> 'a vs -> unknown v list -> 'b v m



  (** {6 String} *)
  val global_stringptr : ?name:string -> string -> i8 pointer v m



  (** {6 Pointers} *)

  val is_null : ?name:string -> 'a pointer v -> i1 v m



  (** {6 Casts} *)

  val bitcast : ?name:string -> 'a v -> 'b typ -> 'b v m
  val pointercast : ?name:string -> 'a pointer v -> ([>`int] as 'b) typ -> 'b v m
  val intcast : ?name:string -> [>`int] v -> ([>`int] as 'a) typ -> 'a v m



  (** {6 Load/Store. Unsafe and type-safe versions} *)

  val unsafe_gep : ?name:string -> 'a pointer v -> i32 v list -> 'unsafe pointer v m

  (** Type-safe GEP

      Do not be fooled by those complex types. They are pretty easy to use:

      [gep v acc1 acc2 ... accn Gep.end_] provides a type safe version of
      [unsafe_gep v [<acc1>; <acc2>; .. ; <accn>]].

      Here acci is an accessor, one of the followings:
       - [Gep.pos n] : Accessing n-th pointer/array/vector elements
       - [Gep.pos_i32 n] : Accessing n-th pointer/array/vector elements by llvalue
       - [Gep.mem<i>] : Accessing n-th element of struct

      You must give appropriate accessors:
      for example, you cannot use [pos n] for n-th element of struct.

      Do not forget to put Gep.end_ at the end of the accessor list.

      Examples:

        - Obtain i32* from i32[20]* p, which points to p[0][n]
            gep p (Gep.pos_const 0) (Gep.pos n) Gep.end_ : i32 pointer v m
        - Obtain i32* from {i1, i16, i32, i64}* p, which points to the i32 element of the struct *p.
            gep pointer (Gep.pos_const 0) Gep.mem2 Gep.end_ : i32 pointer v m

      Type-safe GEP + load/store

      GEP and load/store are often used in conjunctions, gep_load and gep_store are available for such cases:

        - Load i32 p[0][n] of i32[20]* p
            gep_load pointer (Gep.pos_const 0) (Gep.pos n) Gep.end_ : i32 v m
        - Store the i32 element [v] to the 2nd element of {i1, i16, i32, i64}* p
            gep_store v ~dst:pointer (Gep.pos_const 0) Gep.mem2 Gep.end_ : i32 v m
  *)

  val gep : ?name:string
            -> 'a pointer v
            -> (('a pointer, 'x, 'x pointer v m) Gep.t -> 'b)
            -> 'b
  val gep_load : ?name:string
            -> 'a pointer v
            -> (('a pointer, 'x, 'x v m) Gep.t -> 'b)
            -> 'b
  val gep_store : 'x v
            -> dst:'a pointer v
            -> (('a pointer, 'x, unit m) Gep.t -> 'b)
            -> 'b

  val load : ?name:string -> 'a pointer v -> 'a v m
  val store : 'a v -> dst:'a pointer v -> unit m

  val unsafe_const_load : ?name:string -> 'a pointer v -> int list -> 'unsafe v m
  val unsafe_const_store : 'a pointer v -> int list -> 'unsafe v -> unit m



  (** {6 Arithmetic operations} *)

  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 mul :  ?name:string -> ([>`int] as 'a) v -> 'a v -> 'a v m
  val sdiv : ?name:string -> ([>`int] as 'a) v -> 'a v -> 'a v m
  val fadd : ?name:string -> ([>`floating] 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 -> i1 v m
  val fcmp : Llvm.Fcmp.t -> ?name:string -> ([>`floating] as 'a) v -> 'a v -> i1 v m

  (* To remember _E_xclamation for _E_lElVeeEm *)
  val ( +!  ) : ([>`int] as 'a) v -> 'a v -> 'a v m
  val ( -!  ) :  ([>`int] as 'a) v -> 'a v -> 'a v m
  val ( *!  ) :  ([>`int] as 'a) v -> 'a v -> 'a v m
  val ( /!  ) : ([>`int] as 'a) v -> 'a v -> 'a v m
  val ( +.! ) : ([>`floating] as 'a) v -> 'a v -> 'a v m
  val ( -.! ) : ([>`floating] as 'a) v -> 'a v -> 'a v m
  val ( *.! ) : ([>`floating] as 'a) v -> 'a v -> 'a v m
  val ( /.! ) : ([>`floating] as 'a) v -> 'a v -> 'a v m

  (** {6 Arithmetic type conversion} *)

  val sitofp : ?name:string -> [>`int] v -> ([>`floating] as 'a) typ -> 'a v m


  (** {6 Memory}  *)

  val alloca : ?name:string -> 'a typ -> 'a pointer v m
  val alloca_with : ?name:string -> 'a typ -> 'a v -> 'a pointer v m

  (** {6 Useful libc functions} *)

  val printf : string -> unknown v list -> unit m
  (* CR jfuruse: probably (quite unlikely though), we can have a type safer version *)

  val malloc : ?name:string -> ?bzero:bool -> i32 v -> void_pointer v m
  (** malloc by size. *)

  val malloc_by_ty : ?name:string -> ?bzero:bool -> 'a typ -> 'a pointer v m
  (** malloc by type.
      CR: no nelems available.
  *)

  val memcpy : dst:void_pointer v -> src:void_pointer v -> size:i32 v -> void_pointer v m
  val bzero : void_pointer v -> size:i32 v -> unit m
  val free : 'a pointer v -> unit m


  (** {6 Control flow codegens} *)

  val ret : 'a v -> unit m
  val ret_void : unit m

  val phi : ?name:string -> ('a v * llbasicblock) list -> 'a v m

  val cond_br : i1 v -> llbasicblock -> llbasicblock -> unit m

  val br : llbasicblock -> unit m



  (** {6 Basic blocks} *)

  module Block : sig
    val position_at_end : llbasicblock -> unit m
    val insertion : llbasicblock m
    val append : ?name:string -> ('a -> 'b) pointer v -> llbasicblock
    val parent : llbasicblock -> ('a -> 'b) pointer v
  end



  (** {6 Function definition} *)

  val func : string -> 'a typ -> ('b, (string * lltype)) Phantom.ts
    -> ?dump: bool
    -> (('b -> 'a) pointer v (* self *) -> 'b vs -> 'a v m)
    -> ('b -> 'a) pointer v m
  (** [func name return_type arg_types ?dump f] defines a function of a name [name] whose type is
      [arg_types] -> [return_type]. Its function body is defined by [f].
      Self is for recursion.
  *)

  val func0 : string -> ?dump:bool -> 'res typ
    -> unit
    -> ((tpl0 -> 'res) pointer v -> unit -> 'res v m)
    -> (tpl0 -> 'res) pointer v m
  val func1 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ)
    -> ((('a0) tpl1 -> 'res) pointer v -> 'a0 v -> 'res v m)
    -> (('a0) tpl1 -> 'res) pointer v m
  val func2 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ)
    -> ((('a0,'a1) tpl2 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'res v m)
    -> (('a0,'a1) tpl2 -> 'res) pointer v m
  val func3 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ)
    -> ((('a0,'a1,'a2) tpl3 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'res v m)
    -> (('a0,'a1,'a2) tpl3 -> 'res) pointer v m
  val func4 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ) -> (string * 'a3 typ)
    -> ((('a0,'a1,'a2,'a3) tpl4 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'res v m)
    -> (('a0,'a1,'a2,'a3) tpl4 -> 'res) pointer v m
  val func5 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ) -> (string * 'a3 typ) -> (string * 'a4 typ)
    -> ((('a0,'a1,'a2,'a3,'a4) tpl5 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'a4 v -> 'res v m)
    -> (('a0,'a1,'a2,'a3,'a4) tpl5 -> 'res) pointer v m
  val func6 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ) -> (string * 'a3 typ) -> (string * 'a4 typ) -> (string * 'a5 typ)
    -> ((('a0,'a1,'a2,'a3,'a4,'a5) tpl6 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'a4 v -> 'a5 v -> 'res v m)
    -> (('a0,'a1,'a2,'a3,'a4,'a5) tpl6 -> 'res) pointer v m
  val func7 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ) -> (string * 'a3 typ) -> (string * 'a4 typ) -> (string * 'a5 typ) -> (string * 'a6 typ)
    -> ((('a0,'a1,'a2,'a3,'a4,'a5,'a6) tpl7 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'a4 v -> 'a5 v -> 'a6 v -> 'res v m)
    -> (('a0,'a1,'a2,'a3,'a4,'a5,'a6) tpl7 -> 'res) pointer v m
  val func8 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ) -> (string * 'a3 typ) -> (string * 'a4 typ) -> (string * 'a5 typ) -> (string * 'a6 typ) -> (string * 'a7 typ)
    -> ((('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7) tpl8 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'a4 v -> 'a5 v -> 'a6 v -> 'a7 v -> 'res v m)
    -> (('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7) tpl8 -> 'res) pointer v m
  val func9 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ) -> (string * 'a3 typ) -> (string * 'a4 typ) -> (string * 'a5 typ) -> (string * 'a6 typ) -> (string * 'a7 typ) -> (string * 'a8 typ)
    -> ((('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8) tpl9 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'a4 v -> 'a5 v -> 'a6 v -> 'a7 v -> 'a8 v -> 'res v m)
    -> (('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8) tpl9 -> 'res) pointer v m
  val func10 : string -> ?dump:bool -> 'res typ
    -> (string * 'a0 typ) -> (string * 'a1 typ) -> (string * 'a2 typ) -> (string * 'a3 typ) -> (string * 'a4 typ) -> (string * 'a5 typ) -> (string * 'a6 typ) -> (string * 'a7 typ) -> (string * 'a8 typ) -> (string * 'a9 typ)
    -> ((('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8,'a9) tpl10 -> 'res) pointer v -> 'a0 v -> 'a1 v -> 'a2 v -> 'a3 v -> 'a4 v -> 'a5 v -> 'a6 v -> 'a7 v -> 'a8 v -> 'a9 v -> 'res v m)
    -> (('a0,'a1,'a2,'a3,'a4,'a5,'a6,'a7,'a8,'a9) tpl10 -> 'res) pointer v m

  (** {6 Connecting basic blocks} *)

  val return_void : void v m
  (** for functions returning void *)

  val current_function : unit -> ('a -> 'b) pointer v m
  (** Returns the current function. If not in a function, raises Not_found *)

  val append_code_block :
    string (* name *)
    -> 'a v m (* codegen *)
    -> (llbasicblock * 'a v * llbasicblock) m
  (** [append_code_block name vm] appends a basicblock of name [name]
      using the codegen [vm] in the function being defined currently.
      It returns the entering block, the codegen result llvalue, and
      the exiting block. *)

  val if_then_else : i1 v m -> 'a v m -> 'a v m -> 'a v m
  (** Functional condition: Not_found is raised if not defined in a function. *)

  val imp_if_then_else : i1 v m -> unit m -> unit m -> unit m
  (** Imperative condition: Not_found is raised if not defined in a function. *)

  val for_loop :
    'a v (* the init loop value *)
    -> ('a v -> i1 v m) (* test on the loop value *)
    -> ('a v -> 'a v m) (* the loop job + loop value update *)
    -> unit m
  (** Not_found is raised if not defined in a function *)



  (** {6 Execution} *)

  val exec : unit m -> unit
  (** [exec u] creates an anonymous function from [u] and runs it. *)
end