(* Code generation: translate takes a semantically checked AST and
produces LLVM IR

LLVM tutorial: Make sure to read the OCaml version of the tutorial

http://llvm.org/docs/tutorial/index.html

Detailed documentation on the OCaml LLVM library:

http://llvm.moe/
http://llvm.moe/ocaml/

*)

module L = Llvm
module A = Sast

module StringMap = Map.Make(String)

let context = L.global_context ()
let llctx = L.global_context ()
let llmem = L.MemoryBuffer.of_file "lib.bc"
let llm = Llvm_bitreader.parse_bitcode llctx llmem
let the_module = L.create_module context "GIRAPHE"

let i32_t  = L.i32_type  context
and i8_t   = L.i8_type   context
and i1_t   = L.i1_type   context
and f_t    = L.double_type context
and str_t  = L.pointer_type (L.i8_type context)
and ptr_t  = L.pointer_type (L.i8_type context)
and void_t = L.void_type context
and list_t = L.pointer_type (match L.type_by_name llm "struct.List" with
    None -> raise (Failure "struct.List not found")
  | Some x -> x)
and hmap_t = L.pointer_type (match L.type_by_name llm "struct.hashmap_map" with
    None -> raise (Failure "struct.hashmap_map not found")
  | Some x -> x)
and node_t = L.pointer_type (match L.type_by_name llm "struct.Node" with
    None -> raise (Failure "struct.Node not found")
  | Some x -> x)
and edge_t = L.pointer_type (match L.type_by_name llm "struct.Edge" with
    None -> raise (Failure "struct.Edge not found")
  | Some x -> x)
and graph_t = L.pointer_type (match L.type_by_name llm "struct.Graph" with
    None -> raise (Failure "struct.Graph not found")
  | Some x -> x)

let int_zero = L.const_int i32_t 0
and float_zero = L.const_float f_t 0.
and bool_false = L.const_int i1_t 0
and bool_true = L.const_int i1_t 1
and const_null = L.const_int i32_t 0
and str_null = L.const_null str_t
and list_null = L.const_null list_t
and hmap_null = L.const_null hmap_t
and node_null = L.const_null node_t
and graph_null = L.const_null graph_t

let ltype_of_typ = function
    A.Int_t -> i32_t
  | A.Float_t -> f_t
  | A.Bool_t -> i1_t
  | A.String_t -> str_t
  | A.List_Int_t -> list_t
  | A.List_Float_t -> list_t
  | A.List_String_t -> list_t
  | A.List_Node_t -> list_t
  | A.List_Graph_t -> list_t
  | A.List_Bool_t -> list_t
  | A.Dict_Int_t -> hmap_t
  | A.Dict_Float_t -> hmap_t
  | A.Dict_String_t -> hmap_t
  | A.Dict_Node_t -> hmap_t
  | A.Dict_Graph_t -> hmap_t
  | A.Node_t -> node_t
  | A.Edge_t -> edge_t
  | A.Graph_t -> graph_t
  | A.Void_t -> void_t
  | _ -> raise (Failure ("ltype_of_typ error"))

let lconst_of_typ = function
    A.Int_t -> L.const_int i32_t 0
  | A.Float_t -> L.const_int i32_t 1
  | A.Bool_t -> L.const_int i32_t 2
  | A.String_t -> L.const_int i32_t 3
  | A.Node_t -> L.const_int i32_t 4
  | A.Graph_t -> L.const_int i32_t 5
  | A.Edge_t -> L.const_int i32_t 8
  | _ -> raise (Failure ("lconst_of_typ error"))

let get_list_typ = function
    A.List_Int_t -> A.Int_t
  | A.List_Float_t -> A.Float_t
  | A.List_String_t -> A.String_t
  | A.List_Node_t -> A.Node_t
  | A.List_Graph_t -> A.Graph_t
  | A.List_Bool_t -> A.Bool_t
  | _ -> raise (Failure ("get_list_typ error"))

let get_hmap_typ = function
    A.Dict_Int_t -> A.Int_t
  | A.Dict_Float_t -> A.Float_t
  | A.Dict_String_t -> A.String_t
  | A.Dict_Node_t -> A.Node_t
  | A.Dict_Graph_t -> A.Graph_t
  | _ -> raise (Failure ("get_hmap_typ error"))

let null_of_typ = function
  | A.String_t -> str_null
  | A.Node_t -> node_null
  | A.Graph_t -> graph_null
  | A.List_Int_t
  | A.List_Float_t
  | A.List_String_t
  | A.List_Node_t
  | A.List_Graph_t
  | A.List_Bool_t -> list_null
  | A.Dict_Int_t
  | A.Dict_Float_t
  | A.Dict_String_t
  | A.Dict_Node_t
  | A.Dict_Graph_t -> hmap_null
  | _ -> raise (Failure ("null type error"))

let init_val = function
  | A.Int_t as t -> L.const_int (ltype_of_typ t) 0
  | A.Bool_t as t -> L.const_int (ltype_of_typ t) 0
  | A.Float_t as t-> L.const_float (ltype_of_typ t) 0.
  | t-> L.const_null (ltype_of_typ t)

(* Cast data type *)
let to_int_t  = L.function_type i32_t [| L.pointer_type i8_t |]
let to_int_f  = L.declare_function "VoidtoInt" to_int_t the_module
let to_int void_ptr llbuilder =
  let actuals = [| void_ptr |] in
    L.build_call to_int_f actuals "VoidtoInt" llbuilder

let int_to_float llbuilder v = L.build_sitofp v f_t "tmp" llbuilder

let to_float_t  = L.function_type f_t [| L.pointer_type i8_t |]
let to_float_f  = L.declare_function "VoidtoFloat" to_float_t the_module
let to_float void_ptr llbuilder =
  let actuals = [| void_ptr |] in
    L.build_call to_float_f actuals "VoidtoFloat" llbuilder

let to_bool_t  = L.function_type i1_t [| L.pointer_type i8_t |]
let to_bool_f  = L.declare_function "VoidtoBool" to_bool_t the_module
let to_bool void_ptr llbuilder =
  let actuals = [| void_ptr |] in
    L.build_call to_bool_f actuals "VoidtoBool" llbuilder

let to_string_t  = L.function_type str_t [| L.pointer_type i8_t |]
let to_string_f  = L.declare_function "VoidtoString" to_string_t the_module
let to_string void_ptr llbuilder =
  let actuals = [| void_ptr |] in
    L.build_call to_string_f actuals "VoidtoString" llbuilder

let to_node_t  = L.function_type node_t [| L.pointer_type i8_t |]
let to_node_f  = L.declare_function "VoidtoNode" to_node_t the_module
let to_node void_ptr llbuilder =
  let actuals = [| void_ptr |] in
    L.build_call to_node_f actuals "VoidtoNode" llbuilder

let to_graph_t  = L.function_type graph_t [| L.pointer_type i8_t |]
let to_graph_f  = L.declare_function "VoidtoGraph" to_graph_t the_module
let to_graph void_ptr llbuilder =
  let actuals = [| void_ptr |] in
    L.build_call to_graph_f actuals "VoidtoGraph" llbuilder

let void_to_typ data_ptr llbuilder = function
    A.Int_t -> to_int data_ptr llbuilder
  | A.Float_t -> to_float data_ptr llbuilder
  | A.Bool_t -> to_bool data_ptr llbuilder
  | A.String_t -> to_string data_ptr llbuilder
  | A.Node_t -> to_node data_ptr llbuilder
  | A.Graph_t -> to_graph data_ptr llbuilder
  | _ -> raise (Failure("invalid type error"))

(* Print functions *)
let printf_t = L.var_arg_function_type i32_t [| str_t |]
let printf_func = L.declare_function "printf" printf_t the_module
let print_gen llbuilder el =
  L.build_call printf_func (Array.of_list el) "printf" llbuilder

let print_bool_t = L.function_type i32_t [| i1_t |]
let print_bool_f = L.declare_function "printBool" print_bool_t the_module
let print_bool e llbuilder =
  L.build_call print_bool_f [| e |] "print_bool" llbuilder

let print_list_t  = L.function_type i32_t [| list_t |]
let print_list_f  = L.declare_function "printList" print_list_t the_module
let print_list l llbuilder =
  L.build_call print_list_f [| l |] "printList" llbuilder
  
let print_hmap_t  = L.function_type i32_t [| hmap_t |]
let print_hmap_f  = L.declare_function "hashmap_print" print_hmap_t the_module
let print_hmap d llbuilder =
  L.build_call print_hmap_f [| d |] "hashmap_print" llbuilder

let print_node_t  = L.function_type i32_t [| node_t |]
let print_node_f  = L.declare_function "printNode" print_node_t the_module
let print_node node llbuilder =
   L.build_call print_node_f [| node |] "printNode" llbuilder

let print_edge_t  = L.function_type i32_t [| edge_t |]
let print_edge_f  = L.declare_function "printEdgeValue" print_edge_t the_module
let print_edge edge llbuilder =
    L.build_call print_edge_f [| edge |] "printEdge" llbuilder

let print_graph_t  = L.function_type i32_t [| graph_t |]
let print_graph_f  = L.declare_function "printGraph" print_graph_t the_module
let print_graph graph llbuilder =
  L.build_call print_graph_f [| graph |] "printGraph" llbuilder

let string_lit_gen s llbuilder =
  L.build_global_stringptr s "str_tmp" llbuilder

(* List functions *)
let list_init_t  = L.function_type list_t [| i32_t |]
let list_init_f  = L.declare_function "createList" list_init_t the_module
let list_init typ llbuilder =
  let actuals = [|lconst_of_typ typ|]in (
    L.build_call list_init_f actuals "createList" llbuilder
  )

let list_remove_t  = L.var_arg_function_type list_t [| list_t |]
let list_remove_f  = L.declare_function "removeData" list_remove_t the_module
let list_remove data l_ptr llbuilder =
  let actuals = [| l_ptr; data|] in
    (L.build_call list_remove_f actuals "removeData" llbuilder)

let list_add_t  = L.var_arg_function_type list_t [| list_t |]
let list_add_f  = L.declare_function "addList" list_add_t the_module
let list_add data l_ptr llbuilder =
  let actuals = [| l_ptr; data|] in
    (L.build_call list_add_f actuals "addList" llbuilder)

let list_set_t  = L.var_arg_function_type i32_t [| list_t; i32_t |]
let list_set_f  = L.declare_function "setList" list_set_t the_module
let list_set l_ptr index data llbuilder =
  let actuals = [| l_ptr; index; data |] in
    ignore(L.build_call list_set_f actuals "setList" llbuilder);
    l_ptr

let list_size_t  = L.var_arg_function_type i32_t [| list_t |]
let list_size_f  = L.declare_function "getListSize" list_size_t the_module
let list_size l_ptr llbuilder =
  let actuals = [| l_ptr |] in
    L.build_call list_size_f actuals "getListSize" llbuilder

let list_pop_t  = L.var_arg_function_type (L.pointer_type i8_t) [| list_t |]
let list_pop_f  = L.declare_function "popList" list_pop_t the_module
let list_pop l_ptr typ llbuilder =
  let actuals = [| l_ptr |] in
  let data_ptr = L.build_call list_pop_f actuals "popList" llbuilder in
  void_to_typ data_ptr llbuilder typ

let list_get_t  = L.var_arg_function_type (L.pointer_type i8_t) [| list_t; i32_t|]
let list_get_f  = L.declare_function "getList" list_get_t the_module
let list_get l_ptr index typ llbuilder =
  let actuals = [| l_ptr; index|] in
  let data_ptr = L.build_call list_get_f actuals "getList" llbuilder in
  void_to_typ data_ptr llbuilder typ

let list_concat_t  = L.var_arg_function_type list_t [| list_t; list_t |]
let list_concat_f  = L.declare_function "concatList" list_concat_t the_module
let list_concat l_ptr1 l_ptr2 llbuilder =
  let actuals = [| l_ptr1; l_ptr2 |] in
    L.build_call list_concat_f actuals "concatList" llbuilder

let list_contains_t  = L.var_arg_function_type i1_t [| list_t |]
let list_contains_f  = L.declare_function "listContains" list_contains_t the_module
let list_contains l_ptr data llbuilder =
  let actuals = [| l_ptr; data|] in
    (L.build_call list_contains_f actuals "listContains" llbuilder)

let cast_float data typ builder = 
  if typ == A.Float_t then int_to_float builder data else data

let rec list_add_all l_ptr typ llbuilder = function
  | [] -> l_ptr
  | h :: tl -> list_add_all (list_add (cast_float h typ llbuilder) l_ptr llbuilder) typ llbuilder tl

let list_func builder list_ptr params_list expr_tpy = function
  | "remove" -> (list_remove (List.hd params_list) list_ptr builder), expr_tpy
  | "add" -> (list_add (List.hd params_list) list_ptr builder), expr_tpy
  | "get" -> (list_get list_ptr (  List.hd params_list) (get_list_typ expr_tpy) builder), (get_list_typ expr_tpy)
  | "set" -> (list_set list_ptr (List.hd params_list) (List.nth params_list 1) builder), expr_tpy
  | "size" -> (list_size list_ptr builder), A.Int_t
  | "pop" -> (list_pop list_ptr (get_list_typ expr_tpy) builder), (get_list_typ expr_tpy)
  | "push" -> (list_add (List.hd params_list) list_ptr builder), expr_tpy
  | "contains" -> (list_contains list_ptr (List.hd params_list) builder), A.Bool_t
  | _ -> raise (Failure ("invalid list function"))

(* Hashmap functions *)  
let hmap_init_t = L.var_arg_function_type hmap_t [| i32_t; i32_t |]
let hmap_init_f = L.declare_function "hashmap_new" hmap_init_t the_module
let hmap_init fst_typ snd_typ llbuilder =
    L.build_call hmap_init_f [| fst_typ; snd_typ |] "hashmap" llbuilder

let hmap_put_t = L.var_arg_function_type hmap_t [| hmap_t |]
let hmap_put_f = L.declare_function "hashmap_put" hmap_put_t the_module
let hmap_put d key v llbuilder =
    let actuals = [| d; key; v |] in
    ignore (L.build_call hmap_put_f actuals "hashmap_put" llbuilder); d

let hmap_get_t = L.var_arg_function_type (L.pointer_type i8_t) [| hmap_t |]
let hmap_get_f = L.declare_function "hashmap_get" hmap_get_t the_module
let hmap_get hmap_ptr key llbuilder v_typ =
    let actuals = [| hmap_ptr; key |] in
    let data_ptr = L.build_call hmap_get_f actuals "hashmap_get" llbuilder in
    void_to_typ data_ptr llbuilder v_typ

let hmap_remove_t = L.var_arg_function_type hmap_t [| hmap_t |]
let hmap_remove_f = L.declare_function "hashmap_remove" hmap_remove_t the_module
let hmap_remove hmap_ptr key llbuilder =
    let actuals = [| hmap_ptr; key |] in
    L.build_call hmap_remove_f actuals "hashmap_remove" llbuilder

let hmap_size_t = L.var_arg_function_type i32_t [| hmap_t |]
let hmap_size_f = L.declare_function "hashmap_length" hmap_size_t the_module
let hmap_size hmap_ptr llbuilder =
    let actuals = [| hmap_ptr |] in
    L.build_call hmap_size_f actuals "hashmap_length" llbuilder

let hmap_keys_t = L.var_arg_function_type list_t [| hmap_t |]
let hmap_keys_f = L.declare_function "hashmap_keys" hmap_keys_t the_module
let hmap_keys hmap_ptr llbuilder =
    let actuals = [| hmap_ptr |] in
    L.build_call hmap_keys_f actuals "hashmap_keys" llbuilder

let hmap_key_typ_t = L.var_arg_function_type i32_t [| hmap_t |]
let hmap_key_typ_f = L.declare_function "hashmap_keytype" hmap_key_typ_t the_module
let hmap_key_typ hmap_ptr llbuilder =
    let actuals = [| hmap_ptr |] in
    L.build_call hmap_key_typ_f actuals "hashmap_keytype" llbuilder

let hmap_has_key_t = L.var_arg_function_type i1_t [| hmap_t |]
let hmap_has_key_f = L.declare_function "hashmap_haskey" hmap_has_key_t the_module
let hmap_has_key hmap_ptr key llbuilder =
    let actuals = [| hmap_ptr; key |] in
    L.build_call hmap_has_key_f actuals "hashmap_haskey" llbuilder

let rec hmap_put_all hmap_ptr llbuilder = function
  | [] -> hmap_ptr
  | hd :: tl -> ignore(hmap_put hmap_ptr (fst hd) (snd hd) llbuilder); hmap_put_all hmap_ptr llbuilder tl

let hmap_func builder hmap_ptr params_list v_typ = function
  | "get" -> (hmap_get hmap_ptr (List.hd params_list) builder (get_hmap_typ v_typ)), (get_hmap_typ v_typ)
  | "put" -> (hmap_put hmap_ptr (List.hd params_list) (List.nth params_list 1) builder), v_typ
  | "remove" -> (hmap_remove hmap_ptr (List.hd params_list) builder), v_typ
  | "size" -> (hmap_size hmap_ptr builder), A.Int_t
  | "keys" -> (hmap_keys hmap_ptr builder), A.List_Null_t
  | "has" -> (hmap_has_key hmap_ptr (List.hd params_list) builder), A.Bool_t
  | _ as name -> raise (Failure ("invalid hashmap call" ^ name))

(* Node functions *)
let create_node_t  = L.var_arg_function_type node_t [| i32_t; i32_t |]
let create_node_f  = L.declare_function "createNode" create_node_t the_module
let create_node (id, typ, nval) llbuilder =
  let actuals = [| id; lconst_of_typ typ; nval |] in
    L.build_call create_node_f actuals "node" llbuilder

let node_get_value_t = L.function_type ptr_t [| node_t; i32_t |]
let node_get_value_f = L.declare_function "nodeGetValue" node_get_value_t the_module
let node_get_value node typ llbuilder =
  let actuals = [| node; lconst_of_typ typ |] in
  let ret = L.build_call node_get_value_f actuals "nodeValue" llbuilder in
  (   match typ with
    | A.Int_t -> to_int ret llbuilder
    | A.Float_t -> to_float ret llbuilder
    | A.Bool_t -> to_bool ret llbuilder
    | A.String_t -> to_string ret llbuilder
    | _ -> raise (Failure("invalid node value"))
  )

let set_visited_t  = L.function_type i1_t [| node_t |]
  let set_visited_f  = L.declare_function "setVisited" set_visited_t the_module
  let set_visited node llbuilder =
    L.build_call set_visited_f [| node |] "setVisited" llbuilder

let is_visited_t  = L.function_type i1_t [| node_t |]
  let is_visited_f  = L.declare_function "isVisited" is_visited_t the_module
  let is_visited node llbuilder =
    L.build_call is_visited_f [| node |] "isVisited" llbuilder

let node_func builder node_ptr = function
 | "setVisited" -> set_visited node_ptr builder, A.Bool_t
 | "isVisited" -> is_visited node_ptr builder, A.Bool_t
 | _ as name -> raise (Failure ("node function error" ^ name))

(* Edge functions *)
let edge_get_value_t = L.function_type ptr_t [| edge_t; i32_t |]
let edge_get_value_f = L.declare_function "edgeGetValue" edge_get_value_t the_module
let edge_get_value edge typ llbuilder =
  let actuals = [| edge; lconst_of_typ typ |] in
  let ret = L.build_call edge_get_value_f actuals "edgeValue" llbuilder in
  (   match typ with
    | A.Int_t -> to_int ret llbuilder
    | A.Float_t -> to_float ret llbuilder
    | A.Bool_t -> to_bool ret llbuilder
    | A.String_t -> to_string ret llbuilder
    | _ -> raise (Failure("invalid edge value"))
  )

(* Graph functions *)
let create_graph_t  = L.function_type graph_t [| |]
let create_graph_f  = L.declare_function "createGraph" create_graph_t the_module
let create_graph llbuilder =
  L.build_call create_graph_f [| |] "graph" llbuilder

let graph_num_of_nodes_t  = L.function_type i32_t [| graph_t |]
let graph_num_of_nodes_f  = L.declare_function "graphNumOfNodes" graph_num_of_nodes_t the_module
let graph_num_of_nodes g llbuilder =
  L.build_call graph_num_of_nodes_f [| g |] "graphNodeSize" llbuilder

let graph_num_of_edges_t  = L.function_type i32_t [| graph_t |]
let graph_num_of_edges_f  = L.declare_function "graphNumOfEdges" graph_num_of_edges_t the_module
let graph_num_of_edges g llbuilder =
  L.build_call graph_num_of_edges_f [| g |] "graphEdgeSize" llbuilder

let copy_graph_t  = L.function_type graph_t [| graph_t |]
let copy_graph_f  = L.declare_function "copyGraph" copy_graph_t the_module
let copy_graph g llbuilder =
  L.build_call copy_graph_f [| g |] "graph" llbuilder

let merge_graph_t = L.function_type graph_t [| graph_t; graph_t |]
let merge_graph_f = L.declare_function "mergeGraph" merge_graph_t the_module
let merge_graph g1 g2 llbuilder =
  L.build_call merge_graph_f [| g1; g2 |] "graph" llbuilder

let graph_get_root_t  = L.function_type node_t [| graph_t |]
let graph_get_root_f  = L.declare_function "graphGetRoot" graph_get_root_t the_module
let graph_get_root g llbuilder =
  L.build_call graph_get_root_f [| g |] "rootNode" llbuilder

let graph_set_root_t  = L.function_type graph_t [| graph_t; node_t |]
let graph_set_root_f  = L.declare_function "graphSetRoot" graph_set_root_t the_module
let graph_set_root graph node llbuilder = (
      ignore(L.build_call graph_set_root_f [| graph; node |] "setRootRes" llbuilder);
      graph
  )

let graph_add_list_t = L.function_type i32_t [| graph_t; i32_t; list_t; list_t |]
let graph_add_list_f = L.declare_function "graphAddList" graph_add_list_t the_module
let graph_add_list graph vals (edges, etyp) llbuilder =
  let edges = (
    match etyp with
    | A.List_Int_t | A.List_Float_t | A.List_String_t
    | A.List_Node_t | A.List_Graph_t | A.List_Bool_t -> edges
    | _ -> list_null
  ) in
  L.build_call graph_add_list_f [| graph; direction; vals; edges |] "graphAddList" llbuilder
 
let graph_add_node_t = L.function_type i32_t [| graph_t; node_t |]
let graph_add_node_f = L.declare_function "graphAddNode" graph_add_node_t the_module
let graph_add_node graph node llbuilder =
  L.build_call graph_add_node_f [| graph; node |] "addNodeRes" llbuilder

let graph_add_edge_t = L.function_type i32_t
  [| graph_t; node_t; node_t; i32_t; i32_t; f_t; i1_t; str_t |]
let graph_add_edge_f = L.declare_function "graphAddEdge" graph_add_edge_t the_module
let graph_add_edge graph (sour, dest) (typ, vals) llbuilder =
  let actuals = [| graph; sour; dest; int_zero; int_zero; float_zero; bool_false; str_null |] in
  let actuals_r = [| graph; dest; sour; int_zero; int_zero; float_zero; bool_false; str_null |] in
  let (typ_val, loc) = (match typ with
    | A.Int_t -> (0, 4)
    | A.Float_t -> (1, 5)
    | A.Bool_t -> (2, 6)
    | A.String_t -> (3, 7)
    | A.Void_t | A.Null_t -> (-1, 4)
    | _ -> raise (Failure "invalid edge value")
  ) in (
    ignore( actuals.(3) <- (L.const_int i32_t typ_val) );
    ignore( actuals_r.(3) <- (L.const_int i32_t typ_val) );
    ignore( actuals.(loc) <- vals );
    ignore( actuals_r.(loc) <- vals );
  ) 

let graph_edge_exist_t = L.function_type i1_t [| graph_t; node_t; node_t |]
let graph_edge_exist_f = L.declare_function "graphEdgeExist" graph_edge_exist_t the_module
let graph_edge_exist graph sour dest llbuilder =
  L.build_call graph_edge_exist_f [| graph; sour; dest |] "graphEdgeExist" llbuilder

let graph_get_edge_t = L.function_type edge_t [| graph_t; node_t; node_t |]
let graph_get_edge_f = L.declare_function "graphGetEdge" graph_get_edge_t the_module
let graph_get_edge graph sour dest llbuilder =
  L.build_call graph_get_edge_f [| graph; sour; dest |] "edgeValue" llbuilder

let graph_get_child_nodes_t  = L.function_type list_t [| graph_t; node_t |]
let graph_get_child_nodes_f  = L.declare_function "graphGetChildNodes" graph_get_child_nodes_t the_module
let graph_get_child_nodes graph root llbuilder =
  L.build_call graph_get_child_nodes_f [| graph; root |] "childNodes" llbuilder

let graph_get_all_nodes_t  = L.function_type list_t [| graph_t |]
let graph_get_all_nodes_f  = L.declare_function "graphGetAllNodes" graph_get_all_nodes_t the_module
let graph_get_all_nodes graph llbuilder =
  L.build_call graph_get_all_nodes_f [| graph |] "nodesList" llbuilder

let graph_remove_node_t = L.function_type list_t [| graph_t; node_t |]
let graph_remove_node_f = L.declare_function "graphRemoveNode" graph_remove_node_t the_module
let graph_remove_node graph node llbuilder =
  L.build_call graph_remove_node_f [| graph; node |] "listOfSubGraphs" llbuilder

let graph_sub_graph_t = L.function_type list_t [| graph_t; graph_t |]
let graph_sub_graph_f = L.declare_function "subGraph" graph_sub_graph_t the_module
let graph_sub_graph g1 g2 llbuilder =
  L.build_call graph_sub_graph_f [| g1; g2 |] "listOfSubGraphs" llbuilder

let set_allunvisited_t = L.function_type i1_t [|graph_t|]
let set_allunvisited_f = L.declare_function "setAllUnvisited" set_allunvisited_t the_module
let set_allunvisited g llbuilder =
  L.build_call set_allunvisited_f [|g|] "setAllUnvisited" llbuilder

let dfs_t = L.function_type list_t [| graph_t; node_t |]
let dfs_f = L.declare_function "dfs" dfs_t the_module
let dfs g sour llbuilder =
  L.build_call dfs_f [|g; sour |] "dfs" llbuilder


let bfs_t = L.function_type list_t [| graph_t; node_t |]
let bfs_f = L.declare_function "bfs" bfs_t the_module
let bfs g sour llbuilder =
  L.build_call bfs_f [|g; sour |] "bfs" llbuilder

let graph_contains_node_t = L.function_type i1_t [| graph_t; node_t |]
let graph_contains_node_f = L.declare_function "containsNode" graph_contains_node_t the_module
let graph_contains_node graph node llbuilder =
  L.build_call graph_contains_node_f [| graph; node |] "containsNode" llbuilder

let graph_add_edgeP_t = L.var_arg_function_type i32_t [| graph_t; node_t; node_t; i32_t|]
let graph_add_edgeP_f = L.declare_function  "graphAddEdgeP" graph_add_edgeP_t the_module
let graph_add_edgeP g n1 n2 typ data llbuilder =
  L.build_call graph_add_edgeP_f [| g; n1; n2; typ; data |] "graphAddEdge" llbuilder

let dijkstra_t = L.function_type list_t [| graph_t; node_t; node_t |]
let dijkstra_f = L.declare_function "dijkstra" dijkstra_t the_module
let dijkstra graph n1 n2 llbuilder =
  L.build_call dijkstra_f [| graph; n1; n2 |] "dijkstra" llbuilder

let graph_call_default_main llbuilder gh params_list fname=
  let param_list = (List.map (fun e -> fst(e)) params_list) in
  match fname with
  | "root" -> graph_get_root gh llbuilder , A.Node_t
  | "size" -> graph_num_of_nodes gh llbuilder, A.Int_t
  | "getAllNodes" -> graph_get_all_nodes gh llbuilder, A.List_Node_t
  | "setAllUnvisited" -> set_allunvisited gh llbuilder, A.Bool_t
  | "dfs" -> dfs gh (List.hd param_list) llbuilder, A.List_Node_t
  | "bfs" -> bfs gh (List.hd param_list) llbuilder, A.List_Node_t
  | "hasNode" -> graph_contains_node gh (List.hd param_list) llbuilder, A.Bool_t
  | "hasEdge" -> graph_edge_exist gh (List.hd param_list) (List.nth param_list 1) llbuilder, A.Bool_t
  | "addNode" -> graph_add_node gh (List.hd param_list) llbuilder, A.Int_t
  | "addEdge" -> graph_add_edge gh (List.hd param_list, List.nth param_list 1) (snd (List.nth params_list 2), fst (List.nth params_list 2)) llbuilder, A.Int_t
  | "dijkstra" -> dijkstra gh (List.hd param_list) (List.nth param_list 1) llbuilder, A.List_Node_t
  | _ as name -> raise (Failure("graph function error " ^ name ))

let context_funcs_vars = Hashtbl.create 50
let print_hashtbl tb =
  print_endline (Hashtbl.fold (fun k _ m -> (k^", "^m)) tb "")

(* Codegen entry *)
let translate program =
  (* Define each function (arguments and return type) so we can call it *)
  let function_decls =
    let function_decl m fdecl =
      let name = fdecl.A.name
      and formal_types =
	       Array.of_list (List.map (fun (A.Formal(t, _)) -> ltype_of_typ t) fdecl.A.args)
      in
      let ftype = L.var_arg_function_type (ltype_of_typ fdecl.A.returnType) formal_types in
      StringMap.add name (L.define_function name ftype the_module, fdecl) m in
    List.fold_left function_decl StringMap.empty program in

  (* Fill in the body of the given function *)
  let build_function_body fdecl =
    let get_var_name fname n = (fname ^ "." ^ n) in
    let (the_function, _) = StringMap.find fdecl.A.name function_decls in
    (* let bb = L.append_block context "entry" the_function in *)
    let builder = L.builder_at_end context (L.entry_block the_function) in

    (* Construct the function's "locals": formal arguments and locally
       declared variables.  Allocate each on the stack, initialize their
       value, if appropriate, and remember their values in the "locals" map *)
    let _ =
      let add_to_context locals =
        ignore(Hashtbl.add context_funcs_vars fdecl.A.name locals);
        locals
      in
      let add_formal m (A.Formal(t, n)) p =
        let n' = get_var_name fdecl.A.name n in
        let local = L.define_global n' (init_val t) the_module in
          if L.is_null p then () else ignore (L.build_store p local builder);
    	  StringMap.add n' (local, t) m
      in

      let add_local m (A.Formal(t, n)) =
        let n' = get_var_name fdecl.A.name n in
      	let local_var = L.define_global n' (init_val t) the_module in
        StringMap.add n' (local_var, t) m
      in

      let formals = List.fold_left2 add_formal StringMap.empty fdecl.A.args
          (Array.to_list (L.params the_function)) in
      add_to_context (List.fold_left add_local formals fdecl.A.locals)
    in

    (* Return the value for a variable or formal argument *)
    (* let lookup n = StringMap.find n local_vars
    in *)
    let lookup n =
      let get_parent_func_name fname =
        let (_, fdecl) = StringMap.find fname function_decls in
        fdecl.A.pname
      in
      let rec aux n fname = (
        try StringMap.find (get_var_name fname n) (Hashtbl.find context_funcs_vars fname)
        with Not_found -> (
          if fname = "main" then
            (raise (Failure("variable not found")))
          else
            (aux n (get_parent_func_name fname))
        )
      ) in
      aux n fdecl.A.name
    in

    (* Construct code for an expression; return its value *)
    let handle_binop e1 op e2 dtype llbuilder =
      (* Generate llvalues from e1 and e2 *)

      let float_ops op e1 e2 =
        match op with
          A.Add     -> L.build_fadd e1 e2 "flt_addtmp" llbuilder
        | A.Sub     -> L.build_fsub e1 e2 "flt_subtmp" llbuilder
        | A.Mult    -> L.build_fmul e1 e2 "flt_multmp" llbuilder
        | A.Div     -> L.build_fdiv e1 e2 "flt_divtmp" llbuilder
        | A.Mod     -> L.build_frem e1 e2 "flt_sremtmp" llbuilder
        | A.Equal   -> L.build_fcmp L.Fcmp.Oeq e1 e2 "flt_eqtmp" llbuilder
        | A.Neq     -> L.build_fcmp L.Fcmp.One e1 e2 "flt_neqtmp" llbuilder
        | A.Less    -> L.build_fcmp L.Fcmp.Ult e1 e2 "flt_lesstmp" llbuilder
        | A.Leq     -> L.build_fcmp L.Fcmp.Ole e1 e2 "flt_leqtmp" llbuilder
        | A.Greater -> L.build_fcmp L.Fcmp.Ogt e1 e2 "flt_sgttmp" llbuilder
        | A.Geq     -> L.build_fcmp L.Fcmp.Oge e1 e2 "flt_sgetmp" llbuilder
        | _ -> raise (Failure("invalid binary operation"))
      in

      (* chars are considered ints, so they will use int_ops as well*)
      let int_ops op e1 e2 =
        match op with
          A.Add     -> L.build_add e1 e2 "addtmp" llbuilder
        | A.Sub     -> L.build_sub e1 e2 "subtmp" llbuilder
        | A.Mult    -> L.build_mul e1 e2 "multmp" llbuilder
        | A.Div     -> L.build_sdiv e1 e2 "divtmp" llbuilder
        | A.Mod     -> L.build_srem e1 e2 "sremtmp" llbuilder
        | A.And     -> L.build_and e1 e2 "andtmp" llbuilder
        | A.Or      -> L.build_or  e1 e2 "ortmp" llbuilder
        | A.Equal   -> L.build_icmp L.Icmp.Eq e1 e2 "eqtmp" llbuilder
        | A.Neq     -> L.build_icmp L.Icmp.Ne e1 e2 "neqtmp" llbuilder
        | A.Less    -> L.build_icmp L.Icmp.Slt e1 e2 "lesstmp" llbuilder
        | A.Leq     -> L.build_icmp L.Icmp.Sle e1 e2 "leqtmp" llbuilder
        | A.Greater -> L.build_icmp L.Icmp.Sgt e1 e2 "sgttmp" llbuilder
        | A.Geq     -> L.build_icmp L.Icmp.Sge e1 e2 "sgetmp" llbuilder
        | _ -> raise (Failure("invalid binary operation"))
        in
      let type_handler d = match d with
        | A.Float_t -> float_ops op e1 e2
        | A.Bool_t
        | A.Int_t -> int_ops op e1 e2
        | _ -> raise (Failure("invalid type error"))
      in (type_handler dtype,
        match op with
        | A.Add | A.Sub | A.Mult | A.Div | A.Mod -> dtype
        | _ -> A.Bool_t
      )
    in

    let rec expr builder = function
	    A.Num_Lit(A.Num_Int i)   -> (L.const_int i32_t i, A.Int_t)
      | A.Num_Lit(A.Num_Float f) -> (L.const_float f_t f, A.Float_t)
      | A.Bool_lit b -> (L.const_int i1_t (if b then 1 else 0), A.Bool_t)
      | A.String_Lit s -> (string_lit_gen s builder, A.String_t)
      | A.Noexpr -> (L.const_int i32_t 0, A.Void_t)
      | A.Null -> (const_null, A.Null_t)
      | A.Id s ->
          let (var, typ) = lookup s in
          (L.build_load var s builder, typ)
      | A.Node(id, e) ->
          let (nval, typ) = expr builder e in
          (create_node (L.const_int i32_t id, typ, nval) builder, A.Node_t)
      | A.ListP(ls) ->
          let from_expr_typ_to_list_typ = function
              A.Int_t -> A.List_Int_t
            | A.Float_t -> A.List_Float_t
            | A.String_t -> A.List_String_t
            | A.Node_t -> A.List_Node_t
            | A.Graph_t -> A.List_Graph_t
            | A.Bool_t -> A.List_Bool_t
            | _ -> A.List_Int_t
          in
          
          let rec check_float_typ = function
            [] -> A.Int_t
          | hd::ls -> if (snd(expr builder hd)) == A.Float_t 
                      then A.Float_t else check_float_typ ls in
          
          let rec check_graph_typ = function
              [] -> A.Node_t
            | hd::ls -> if (snd(expr builder hd)) == A.Graph_t 
                        then A.Graph_t else check_graph_typ ls in
          
          let list_typ = snd (expr builder (List.hd ls)) in
          let list_typ = if list_typ == A.Int_t 
            then check_float_typ ls else list_typ in
          let list_typ = if list_typ == A.Node_t 
            then check_graph_typ ls else list_typ in

          let list_conversion el =
            let (e_val, e_typ) = expr builder el in
            (   match e_typ with
              | A.Node_t when list_typ = A.Graph_t -> (
                  let gh = create_graph builder in (
                      ignore(graph_add_node gh e_val builder);
                      (gh, A.Graph_t)
                  )
                )
              | _ -> (e_val, e_typ)
            )
          in

          let list_ptr_t = (list_init list_typ builder, 
            from_expr_typ_to_list_typ list_typ) in
              list_add_all (fst list_ptr_t) list_typ builder (
                List.map fst (List.map list_conversion ls)), (snd list_ptr_t)

      | A.DictP(expr_list) ->
          let from_type_to_hmap_typ = function
              A.Int_t -> A.Dict_Int_t
            | A.String_t -> A.Dict_String_t
            | A.Node_t -> A.Dict_Node_t
            | A.Float_t -> A.Dict_Float_t
            | A.Graph_t -> A.Dict_Graph_t
            | _ -> raise (Failure "hmap type error")
          in
          let first_expr_kv = List.hd expr_list in
          (* get type of key and value *)
          let typ1 = lconst_of_typ (snd (expr builder (fst first_expr_kv))) in
          let typ2 = lconst_of_typ (snd (expr builder (snd first_expr_kv))) in
          let return_typ = from_type_to_hmap_typ (snd (expr builder (snd first_expr_kv))) in
          let hmap_ptr = hmap_init typ1 typ2 builder in
          ignore(hmap_put_all hmap_ptr builder
                (List.map (fun (key, v) -> fst(expr builder key), fst(expr builder v)) expr_list), return_typ);
                (hmap_ptr, return_typ)

       | A.Graph_Link(left, right, edges) ->       (*  *)
          let (ln, ln_type) = expr builder left in
          let (rn, rn_type) = expr builder right in
          let (el, el_type) = expr builder edges in (
            match (ln_type, rn_type, el_type) with
            | (A.Node_t, A.Null_t, _) -> (
                let gh = create_graph builder in (
                    ignore(graph_add_node gh ln builder);
                    (gh, A.Graph_t)
                )
              )
            | (A.Node_t, A.Node_t, _) -> (
                let gh = create_graph builder in (
                    ignore(graph_add_node gh ln builder); (* Also set the root *)
                    ignore(graph_add_node gh rn builder);
                    ignore(graph_add_edge gh (ln, rn) (el_type, el) builder);
                    (gh, A.Graph_t)
                )
              )
            | (A.Node_t, A.Graph_t, _) -> (
                let gh = copy_graph rn builder in
                let rt = graph_get_root rn builder in (
                    ignore(graph_add_node gh ln builder);
                    ignore(graph_set_root gh ln builder);
                    ignore(graph_add_edge gh (ln, rt) (el_type, el) builder);
                    (gh, A.Graph_t)
                )
              )
            | (A.Node_t, A.List_Graph_t, _)
            | (A.Node_t, A.List_Node_t, _) -> (
                let gh = create_graph builder in (
                  ignore(graph_add_node gh ln builder); (* Also set the root *)
                  ignore(graph_add_list gh rn (el, el_type) builder);
                  (gh, A.Graph_t)
                )
              )
            | _ -> raise (Failure "graph link error")
          ) 
      | A.Binop (e1, op, e2) ->
        let (e1', t1) = expr builder e1
        and (e2', t2) = expr builder e2 in
        (* Handle Automatic Binop Type Converstion *)
        (match (t1, t2) with
          | (A.List_Int_t, A.List_Int_t)
          | (A.List_Float_t, A.List_Float_t)
          | (A.List_Bool_t, A.List_Bool_t)
          | (A.List_String_t, A.List_String_t)
          | (A.List_Node_t, A.List_Node_t)
          | (A.List_Graph_t, A.List_Graph_t) -> (
                match op with
                | A.Add -> (list_concat e1' e2' builder, t1)
                | _ -> raise (Failure("invalid graph operation"))
              )
	  | (A.List_Int_t, A.Int_t)
	  | (A.List_Float_t, A.Float_t)
	  | (A.List_Bool_t, A.Bool_t)
	  | (A.List_String_t, A.String_t)
	  | (A.List_Node_t, A.Node_t)
	  | (A.List_Graph_t, A.Graph_t)-> (
	  	match op with
		| A.Add -> (list_add e2' e1' builder, t1)
		| A.Sub -> (list_remove e2' e1' builder, t1)
		| _ -> raise (Failure (""))
	  )
          | ( A.Graph_t, A.Graph_t) -> (
                match op with
                | A.Add -> (merge_graph e1' e2' builder, A.Graph_t)
                | A.Sub -> (graph_sub_graph e1' e2' builder, A.List_Graph_t)
                | _ -> raise (Failure("invalid graph operation"))
              )
           | ( A.Graph_t, A.Node_t ) -> (  (* *)
                match  op with
                | A.RootAs ->
                    let gh = copy_graph e1' builder in
                      (graph_set_root gh e2' builder, A.Graph_t)
                | A.ListNodesAt -> (graph_get_child_nodes e1' e2' builder, A.List_Node_t)
                | A.Sub -> (graph_remove_node e1' e2' builder, A.List_Graph_t)
                | _ -> raise (Failure("invalid operation"))
            ) 
          | ( _, A.Null_t ) -> (
                  match op with
                | A.Equal -> (L.build_is_null e1' "isNull" builder, A.Bool_t)
                | A.Neq -> (L.build_is_not_null e1' "isNull" builder, A.Bool_t)
                | _ -> raise (Failure("invalid operation"))
            )
          | ( A.Null_t, _ ) -> (
                  match op with
                | A.Equal -> (L.build_is_null e2' "isNotNull" builder, A.Bool_t)
                | A.Neq -> (L.build_is_not_null e2' "isNotNull" builder, A.Bool_t)
                | _ -> raise (Failure("invalid operation"))
            )
          | ( t1, t2) when t1 = t2 -> handle_binop e1' op e2' t1 builder
          | ( A.Int_t, A.Float_t) ->
              handle_binop (int_to_float builder e1') op e2' A.Float_t builder
          | ( A.Float_t, A.Int_t ) ->
              handle_binop e1' op (int_to_float builder e2') A.Float_t builder
          | _ -> raise (Failure ("invalid operation"))
        )
      | A.Unop(op, e) ->
      	  let (e', typ) = expr builder e in
      	  ((match op with
      	    A.Neg     -> if typ = A.Int_t then L.build_neg else L.build_fneg
          | A.Not     -> L.build_not) e' "tmp" builder, typ)
      | A.Assign (s, e) ->
          let (e', etyp) = expr builder e in
          let (var, typ) = lookup s in
          (( match (etyp, typ) with
            | (t1, t2) when t1 = t2 -> ignore (L.build_store e' var builder); e'
            | (A.List_Null_t, _) -> ignore (L.build_store e' var builder); e' 
            | (A.Null_t, _) -> ignore (L.build_store (null_of_typ typ) var builder); (null_of_typ typ)
            | (A.Int_t, A.Float_t) -> let e' = (int_to_float builder e') in ignore (L.build_store e' var builder); e'
            | (A.List_Node_t, _) -> ignore (L.build_store e' var builder); e'
            | _ -> raise (Failure("assign type error"))
          ), typ)
      | A.Call ("print", el) ->
          let print_expr e =
            let (eval, etyp) = expr builder e in (
              match etyp with
              | A.Int_t -> ignore(print_gen builder [(string_lit_gen "%d\n" builder); eval])
              | A.Null_t -> ignore(print_gen builder [(string_lit_gen "null\n" builder)])
              | A.Bool_t -> ignore(print_bool eval builder)
              | A.Float_t -> ignore(print_gen builder [(string_lit_gen "%f\n" builder); eval])
              | A.String_t -> ignore(print_gen builder [(string_lit_gen "%s\n" builder); eval])
              | A.Node_t -> ignore(print_node eval builder)
              | A.Edge_t -> ignore(print_edge eval builder)
              | A.Dict_Int_t | A.Dict_Float_t | A.Dict_String_t | A.Dict_Node_t
              | A.Dict_Graph_t -> ignore(print_hmap eval builder)
              | A.List_Int_t -> ignore(print_list eval builder)
              | A.List_Float_t -> ignore(print_list eval builder)
              | A.List_Bool_t -> ignore(print_list eval builder)
              | A.List_String_t -> ignore(print_list eval builder)
              | A.List_Node_t -> ignore(print_list eval builder)
              | A.List_Graph_t -> ignore(print_list eval builder)
              | A.Graph_t -> ignore(print_graph eval builder)
              | _ -> raise (Failure("invalid print type"))
          ) in List.iter print_expr el; (L.const_int i32_t 0, A.Void_t)
      | A.Call ("printf", el) ->
          (print_gen builder (List.map
            (fun e -> (let (eval, _) = expr builder e in eval))
            el), A.Void_t)
      | A.Call (f, act) ->
         let (fdef, fdecl) = StringMap.find f function_decls in
      	 let actuals = List.rev (List.map
          (fun e -> (let (eval, _) = expr builder e in eval)) (List.rev act)) in
      	 let result = (match fdecl.A.returnType with A.Void_t -> ""
                                                   | _ -> f ^ "_result") in
         (L.build_call fdef (Array.of_list actuals) result builder, fdecl.A.returnType)

      (* default get operator of hmap *)
      | A.CallDefault(val_name, default_func_name, params_list) ->
        (* get caller tpye *)
        let (id_val, expr_tpy) = (expr builder val_name) in
        let assign_func_by_typ builder = function
          (* deal with list *)
          | A.List_Int_t | A.List_Float_t | A.List_String_t | A.List_Bool_t
          | A.List_Node_t | A.List_Graph_t ->
              list_func builder id_val (List.map (fun e -> fst (expr builder e)) params_list) expr_tpy default_func_name
          | A.Dict_Int_t | A.Dict_Float_t | A.Dict_String_t | A.Dict_Node_t | A.Dict_Graph_t ->
              hmap_func builder id_val (List.map (fun e -> fst (expr builder e)) params_list) expr_tpy default_func_name
          | A.Graph_t ->
              graph_call_default_main builder id_val (List.map (fun e -> (expr builder e)) params_list) default_func_name
	  | A.Node_t ->
              node_func builder id_val default_func_name
          | _ -> raise (Failure ("invalid function"))
          in
            assign_func_by_typ builder expr_tpy

(*       | _ -> (L.const_int i32_t 0, A.Void_t)
 *)    in

    (* Invoke "f builder" if the current block doesn't already
       have a terminal (e.g., a branch). *)
    let add_terminal builder f =
      match L.block_terminator (L.insertion_block builder) with
	      Some _ -> ()
      | None -> ignore (f builder) in

    (* Build the code for the given statement; return the builder for
       the statement's successor *)
    let rec stmt builder = function
      | A.Expr e -> ignore (expr builder e); builder
      | A.Return e ->
          ignore (
            let (ev, et) = expr builder e in
            match (fdecl.A.returnType, et) with
  	          (A.Void_t, _) -> L.build_ret_void builder
  	        | (t1, t2) when t1 = t2 -> L.build_ret ev builder
            | (A.Float_t, A.Int_t) -> L.build_ret (int_to_float builder ev) builder
            | (t1, A.Null_t) -> L.build_ret (init_val t1) builder
            | _ -> raise (Failure("return type error"))
          ); builder
      | A.If (predicate, then_stmt, else_stmt) ->
         let (bool_val, _) = expr builder predicate in
      	 let merge_bb = L.append_block context "merge" the_function in

      	 let then_bb = L.append_block context "then" the_function in
      	 add_terminal (
             List.fold_left stmt (L.builder_at_end context then_bb) then_stmt
           ) (L.build_br merge_bb);

      	 let else_bb = L.append_block context "else" the_function in
         add_terminal (
             List.fold_left stmt (L.builder_at_end context else_bb) else_stmt
           ) (L.build_br merge_bb);

      	 ignore (L.build_cond_br bool_val then_bb else_bb builder);
      	 L.builder_at_end context merge_bb

      | A.While (predicate, body) ->
      	  let pred_bb = L.append_block context "while" the_function in
      	  ignore (L.build_br pred_bb builder);

      	  let body_bb = L.append_block context "while_body" the_function in
      	  add_terminal (
              List.fold_left stmt (L.builder_at_end context body_bb) body
            ) (L.build_br pred_bb);

      	  let pred_builder = L.builder_at_end context pred_bb in
      	  let (bool_val, _) = expr pred_builder predicate in

      	  let merge_bb = L.append_block context "merge" the_function in
      	  ignore (L.build_cond_br bool_val body_bb merge_bb pred_builder);
      	  L.builder_at_end context merge_bb

      | A.For (e1, e2, e3, body) -> List.fold_left stmt builder
	       ( [A.Expr e1 ; A.While (e2, body @ [A.Expr e3]) ] )
    in

    (* Build the code for each statement in the function *)
    let builder = List.fold_left stmt builder fdecl.A.body in

    (* Add a return if the last block falls off the end *)
    add_terminal builder (match fdecl.A.returnType with
        A.Void_t -> L.build_ret_void
      | A.Int_t as t -> L.build_ret (L.const_int (ltype_of_typ t) 0)
      | A.Bool_t as t -> L.build_ret (L.const_int (ltype_of_typ t) 0)
      | A.Float_t as t-> L.build_ret (L.const_float (ltype_of_typ t) 0.)
      | t-> L.build_ret (L.const_null (ltype_of_typ t))
    )
  in

  List.iter build_function_body (List.rev program);

  the_module
