Source

ocaml-llvm-phantom / lib / build_intf.ml

open Spotlib.Spot
open Phantom
open Type
open Value

module type S = sig

  (** Builder monad *)

  module Monad : sig
    include Monad_intf.T with type 'a t = Llvm.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 store in the monad [m] *)

  (** Lifted value coercions *)      
  val unknownM : 'a v m -> unknown v m
  val magicM : 'a v m -> 'b v m



  (** 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



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



  (** Pointers *)

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



  (** 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



  (** 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 pointer (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



  (** 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


  (** Arithmetic type conversion *)

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


  (** Memory *)

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


  (** 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


  (** Control flow codegens *)

  val ret : 'a v -> unit m
  val ret_void : unit m
    
  val phi : ?name:string -> ('a v * Llvm.llbasicblock) list -> 'a v m

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

  val br : Llvm.llbasicblock -> unit m



  (** Basic blocks *)

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



  (** Function definition *)

  val func : string -> 'a typ -> ('b, (string * Llvm.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

  (** 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 *)
    -> (Llvm.llbasicblock * 'a v * Llvm.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 *)



  (** Execution *)

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