<commit_before>(* The MIT License (MIT)
 *
 * Copyright (c) 2015 <NAME>
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to deal
 * in the Software without restriction, including without limitation the rights
 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 * copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in all
 * copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 * SOFTWARE.
 *)

open Llvm

exception Error of string

let context = global_context ()
let the_module = create_module context "iris"
let builder = builder context

(* symbol table *)
let named_values:(string, llvalue) Hashtbl.t = Hashtbl.create 10

let int_type = i32_type context
let float_type = double_type context
let bool_type = i1_type context

let int_of_bool = function
  | false -> 0
  | true -> 1

(* lookup a function or throw an exception *)
let lookupf_exn name =
  match lookup_function name the_module with
  | Some v -> v
  | None -> raise (Error ("Unknown function: " ^ name))

(* converts "Int" to iris_int_type, "()" to void_type, etc. *)
let iris_type_from_string = function
  | "Int" -> int_type
  | "Float" -> float_type
  | "Bool" -> bool_type
  | _ -> int_type (* will change *)

let string_of_iris_type = function
  | int_type -> "Int"
  | float_type -> "Float"
  | bool_type -> "Bool"
  | _ -> raise (Error ("Unknown type"))

(* Needs refactoring *)
let iris_type_of llval =
  match type_of llval with
  | float_type -> float_type
  | bool_type -> bool_type
  | int_type -> int_type
  | _ -> raise (Error ("Unknown type"))

(* Create an alloca instruction in the entry block of a function. This is
   used for mutable variables, etc. *)
let create_entry_block_alloca the_function name ty =
  let builder = builder_at context (instr_begin (entry_block the_function)) in
  build_alloca ty name builder

(* Create an alloca for each argument and register the argument in the symbol
   table so that references to it will succeed. *)
let create_argument_allocas the_function proto =
  let (args, tys) = match proto with
    | Ast.Prototype (_, args, tys, _) -> (args, tys)
  in
  Array.iteri (fun i ai ->
    let name = args.(i) in
    let ty = (iris_type_from_string tys.(i)) in
    (* Allocate the stack space. *)
    let alloca = create_entry_block_alloca the_function name ty in

    (* Store the initial value into the alloca. *)
    ignore(build_store ai alloca builder);

    (* Add args to the symbol table. *)
    Hashtbl.add named_values name alloca;
  ) (params the_function)

(* Should clean these up at some point *)

let add_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_add lhs rhs "addtmp" builder
  | TypeKind.Double ->
    build_fadd lhs rhs "addtmp" builder
  | _ -> raise (Error "Type error on add!")

let sub_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_sub lhs rhs "subtmp" builder
  | TypeKind.Double ->
    build_fsub lhs rhs "subtmp" builder
  | _ -> raise (Error "Type error on sub!")

let mul_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_mul lhs rhs "multmp" builder
  | TypeKind.Double ->
    build_fmul lhs rhs "multmp" builder
  | _ -> raise (Error "Type error on mul!")

let div_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_sdiv lhs rhs "divtmp" builder
  | TypeKind.Double ->
    build_fdiv lhs rhs "divtmp" builder
  | _ -> raise (Error "Type error on div!")

let mod_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_srem lhs rhs "modtmp" builder
  | TypeKind.Double ->
    build_frem lhs rhs "modtmp" builder
  | _ -> raise (Error "Type error on div!")

let rec codegen_expr = function
  | Ast.Int i -> const_int int_type i
  | Ast.Bool b -> const_int bool_type (int_of_bool b)
  | Ast.Float f -> const_float float_type f
  | Ast.Binary (op, lhs, rhs) ->
    let lhs_val = codegen_expr lhs in
    let rhs_val = codegen_expr rhs in
    begin
      match op with
      | '+' -> add_op lhs_val rhs_val
      | '-' -> sub_op lhs_val rhs_val
      | '*' -> mul_op lhs_val rhs_val
      | '/' -> div_op lhs_val rhs_val
      | '%' -> mod_op lhs_val rhs_val
      | _ -> raise (Error "invalid infix operator")
    end
  | Ast.For (var_name, start, end_val, body) ->
    let the_function = block_parent (insertion_block builder) in

    (* Emit the start code first *)
    let start_val = codegen_expr start in

    (* Create stack space for the variable in the entry block. *)
    let alloca =
      create_entry_block_alloca the_function  var_name (type_of start_val)
    in

    (* Store the value on the stack. *)
    ignore (build_store start_val alloca builder);

    (* Make a new basic block for the loop header, inserting after current block *)
    let loop_bb = append_block context "loop" the_function in

    (* Insert an explicit fall through from the current block to the loop_bb *)
    ignore (build_br loop_bb builder);

    (* Start insertion in loop_bb. *)
    position_at_end loop_bb builder;

    (* Within the loop, the variable is defined equal to the PHI node. If it
       shadows and existing variable, we have to restore it, so save it. *)
    let old_val =
      try Some (Hashtbl.find named_values var_name) with Not_found -> None
    in
    Hashtbl.add named_values var_name alloca;<commit_msg>initial function call codegen<commit_after>(* The MIT License (MIT)
 *
 * Copyright (c) 2015 <NAME>
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to deal
 * in the Software without restriction, including without limitation the rights
 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
 * copies of the Software, and to permit persons to whom the Software is
 * furnished to do so, subject to the following conditions:
 *
 * The above copyright notice and this permission notice shall be included in all
 * copies or substantial portions of the Software.
 *
 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 * SOFTWARE.
 *)

open Llvm

exception Error of string

let context = global_context ()
let the_module = create_module context "iris"
let builder = builder context

(* symbol table *)
let named_values:(string, llvalue) Hashtbl.t = Hashtbl.create 10

let int_type = i32_type context
let float_type = double_type context
let bool_type = i1_type context

let int_of_bool = function
  | false -> 0
  | true -> 1

(* lookup a function or throw an exception *)
let lookupf_exn name =
  match lookup_function name the_module with
  | Some v -> v
  | None -> raise (Error ("Unknown function: " ^ name))

(* converts "Int" to iris_int_type, "()" to void_type, etc. *)
let iris_type_from_string = function
  | "Int" -> int_type
  | "Float" -> float_type
  | "Bool" -> bool_type
  | _ -> int_type (* will change *)

let string_of_iris_type = function
  | int_type -> "Int"
  | float_type -> "Float"
  | bool_type -> "Bool"
  | _ -> raise (Error ("Unknown type"))

(* Needs refactoring *)
let iris_type_of llval =
  match type_of llval with
  | float_type -> float_type
  | bool_type -> bool_type
  | int_type -> int_type
  | _ -> raise (Error ("Unknown type"))

(* Create an alloca instruction in the entry block of a function. This is
   used for mutable variables, etc. *)
let create_entry_block_alloca the_function name ty =
  let builder = builder_at context (instr_begin (entry_block the_function)) in
  build_alloca ty name builder

(* Create an alloca for each argument and register the argument in the symbol
   table so that references to it will succeed. *)
let create_argument_allocas the_function proto =
  let (args, tys) = match proto with
    | Ast.Prototype (_, args, tys, _) -> (args, tys)
  in
  Array.iteri (fun i ai ->
    let name = args.(i) in
    let ty = (iris_type_from_string tys.(i)) in
    (* Allocate the stack space. *)
    let alloca = create_entry_block_alloca the_function name ty in

    (* Store the initial value into the alloca. *)
    ignore(build_store ai alloca builder);

    (* Add args to the symbol table. *)
    Hashtbl.add named_values name alloca;
  ) (params the_function)

(* Should clean these up at some point *)

let add_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_add lhs rhs "addtmp" builder
  | TypeKind.Double ->
    build_fadd lhs rhs "addtmp" builder
  | _ -> raise (Error "Type error on add!")

let sub_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_sub lhs rhs "subtmp" builder
  | TypeKind.Double ->
    build_fsub lhs rhs "subtmp" builder
  | _ -> raise (Error "Type error on sub!")

let mul_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_mul lhs rhs "multmp" builder
  | TypeKind.Double ->
    build_fmul lhs rhs "multmp" builder
  | _ -> raise (Error "Type error on mul!")

let div_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_sdiv lhs rhs "divtmp" builder
  | TypeKind.Double ->
    build_fdiv lhs rhs "divtmp" builder
  | _ -> raise (Error "Type error on div!")

let mod_op lhs rhs =
  let ty = classify_type (type_of lhs) in
  match ty with
  | TypeKind.Integer ->
    build_srem lhs rhs "modtmp" builder
  | TypeKind.Double ->
    build_frem lhs rhs "modtmp" builder
  | _ -> raise (Error "Type error on div!")

let rec codegen_expr = function
  | Ast.Int i -> const_int int_type i
  | Ast.Bool b -> const_int bool_type (int_of_bool b)
  | Ast.Float f -> const_float float_type f
  | Ast.Binary (op, lhs, rhs) ->
    let lhs_val = codegen_expr lhs in
    let rhs_val = codegen_expr rhs in
    begin
      match op with
      | '+' -> add_op lhs_val rhs_val
      | '-' -> sub_op lhs_val rhs_val
      | '*' -> mul_op lhs_val rhs_val
      | '/' -> div_op lhs_val rhs_val
      | '%' -> mod_op lhs_val rhs_val
      | _ -> raise (Error "invalid infix operator")
    end
  | Ast.Call (callee, args) ->
    (* Lookup name in module. *)
    let callee =
      match lookup_function callee the_module with
      | Some callee -> callee
      | None -> raise (Error ("Unknown function: " ^ callee))
    in
    let params = params callee in

    (* Check for arity mismatch. *)
    if Array.length params == Array.length args then () else
      raise (Error (Printf.sprintf "wrong number of args passed: %d for %d" (Array.length args) (Array.length params)));
    let args = (Array.map (fun i -> codegen_expr i) args) in
    build_call callee args "calltmp" builder
  | Ast.For (var_name, start, end_val, body) ->
    let the_function = block_parent (insertion_block builder) in

    (* Emit the start code first *)
    let start_val = codegen_expr start in

    (* Create stack space for the variable in the entry block. *)
    let alloca =
      create_entry_block_alloca the_function  var_name (type_of start_val)
    in

    (* Store the value on the stack. *)
    ignore (build_store start_val alloca builder);

    (* Make a new basic block for the loop header, inserting after current block *)
    let loop_bb = append_block context "loop" the_function in

    (* Insert an explicit fall through from the current block to the loop_bb *)
    ignore (build_br loop_bb builder);

    (* Start insertion in loop_bb. *)
    position_at_end loop_bb builder;

    (* Within the loop, the variable is defined equal to the PHI node. If it
       shadows and existing variable, we have to restore it, so save it. *)
    let old_val =
      try Some (Hashtbl.find named_values var_name) with Not_found -> None
    in
    Hashtbl.add named_values var_name alloca;
{'fraction_non_alphanumeric': 0.08610086100861009, 'fraction_numerical': 0.0016912669126691268, 'mean_word_length': 3.266644801574287, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 99, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '775091', 'n_tokens_mistral': 4101, 'n_tokens_neox': 4010, 'n_words': 1601}