open Ast
open Sast
open Printast
open Printsast
open Semantic
open Exception
open Printf
open Builtin
open Str

(* To remember whether a function in C is already created *)
module FunSet = Set.Make(struct
    type t = string
    let compare x y = Pervasives.compare x y
end)

let dyna_out_init = open_out "./library/dynamic_builtin.cc";;
let dyna_out = open_out_gen
    [Open_wronly; Open_append; Open_creat; Open_text]
    0o666 "./library/dynamic_builtin.cc";;
let c_header_list = ["<cstdio>"; "<cstdlib>";
                        "<gmp.h>"; "<library/builtin.cc>";
                        "<library/dynamic_builtin.cc>"];;

(* in order to assign unique id in C *)
let id_counter = ref 0;;
let fun_db = ref FunSet.empty;;

module Translate = struct

exception Funciton_call_without_function_name

(* generate the syntax of c *)
let rec c_header_generator = function
| [] -> ""
| head::tail -> "#include " ^ head ^ "\n" ^ (c_header_generator tail);;

let c_main_left =
    "int main(int argc, char *argv[]){\n";;
let c_main_right = "    return 0;\n}\n";;

let rec string_of_type = function
| Int -> "string"
| Bits(i) -> sprintf "bitset<%d>" i
| String -> "string"
| Vector(t, i_l) ->
    let in_str_type =
        if List.length i_l = 1 then
            string_of_type t
        else
            string_of_type (Vector(t, List.tl i_l)) in
    sprintf "vector< %s >" in_str_type
| Fun(Fix, out_t, in_t_l) ->
    let in_ts_l = List.map string_of_type in_t_l in
    sprintf "function<%s (%s)>" (string_of_type out_t)
    (List.fold_left (fun s1 s2 -> s1 ^ ", " ^ s2)
        (List.hd in_ts_l)
        (List.tl in_ts_l))
| Fun(_, _, _) -> raise(Dev_Error("the type should be confirmed (fun)"))
| Wild_Card(i) -> raise(Dev_Error("the type should be confirmed (wc)"))
| Special(s) -> raise(Dev_Error("the type should be confirmed (sp)"))

(* create indent in C *)
let rec str_ind layer =
if layer >= 1 then
    "    " ^ str_ind (layer-1)
else
    "";;

(* create [1;2;3;...;len-1] *)
let rec range len =
    if len = 0 then []
    else (len-1) :: range (len - 1)

let rec cout_vector var t i_l =
    if List.length i_l = 1 then
        let len = List.hd i_l in
        match t with
        | Bits(j) ->
            sprintf "%scout <<\"{\";\n%scout << \"}\";\n" (str_ind 1)
            (List.fold_left
                (fun s i -> sprintf
                    "%s printf(\" \");\nprintbit<%d>(%s[%d]);\n"
                    s j var i)
                (sprintf "printbit<%d>(%s[%d]);\n" j var 0)
                (List.tl (List.rev (range len))))
        | _ ->
            sprintf "%scout <<\"{\";\n%s << \"}\";\n" (str_ind 1)
            (List.fold_left (fun s i -> sprintf "%s <<\" \"<< %s[%d]" s var i)
                (sprintf "cout << %s[0]" var)
                (List.tl (List.rev (range len))))
    else
        let len = List.hd i_l in
        (List.fold_left
            (fun s i -> s ^
                "    cout << \"\\n\";\n" ^
                (cout_vector (sprintf "%s[%d]" var i) t (List.tl i_l)))
            (sprintf "%scout << \"{\";\n%s"
                (str_ind 1) (cout_vector
                    (sprintf "%s[%d]" var 0) t (List.tl i_l) ))
            (List.tl (List.rev (range len)))) ^
        "    cout <<\"}\";\n"
;;

(* input Vector(Int, [3;8;5]) return Vector(Int, [8;5] *)
let decrease_dim = function
| Vector(t, i_l) ->
    if List.length i_l > 1 then
        Vector(t, List.tl i_l)
    else
        t
| _ -> raise(Dev_Error("non-vector type cannot decrease dimension"))
;;

(* input (hello, 3), output hello, hello, hello *)
let rec string_repeat s n =
    if n <= 1 then
        s
    else
        s ^ ", " ^ (string_repeat s (n-1))
;;

(* generate the name of vector argument *)
let rec gen_make_vec_args n =
    if n <= 1 then
        sprintf "string at__%d" n
    else
        sprintf "%s, string at__%d" (gen_make_vec_args (n-1)) n
;;

(* generate the code of initialize vector *)
let rec init_vector indent ids dim_l =
    if List.length dim_l = 1 then
        sprintf "%s%s.resize(%d);\n" (str_ind indent) ids (List.hd dim_l)
    else
        let l = List.length dim_l in
        (sprintf "%s%s.resize(%d);\n" (str_ind indent) ids (List.hd dim_l)) ^
        (sprintf "%sfor (int i%d = 0; i%d < %d; i%d++) {\n"
            (str_ind indent) l l (List.hd dim_l) l) ^
        (init_vector (indent+1) (sprintf "%s[i%d]" ids l) (List.tl dim_l))^
        (sprintf "%s}" (str_ind indent))
;;

(* generate the for loop to implement make-vector *)
let rec for_make_vector indent dim_l =
    let up_limit = List.hd dim_l in
    let l = List.length dim_l in
    if l = 1 then
        sprintf "%sfor (int i%d = 0; i%d < %d; i%d++)\n"
            (str_ind indent) l l up_limit l
    else
        sprintf "%sfor (int i%d = 0; i%d < %d; i%d++)\n%s"
            (str_ind indent) l l up_limit l
        (for_make_vector (indent+1) (List.tl dim_l))
;;

(* generate the dimension index of make-vector *)
let rec dim_ind_make_vec n =
    if n = 0 then
        ""
    else
        (sprintf "[i%d]" n) ^ (dim_ind_make_vec (n-1))
;;

(* generate the tmp index in for loop for make-vector *)
let rec ind_arg_make_vec n =
    if n = 1 then
        sprintf "to_string(i%d)" n
    else
        (sprintf "to_string(i%d), " n) ^ (ind_arg_make_vec (n-1))
;;

(* return the name of the type corresponding in C *)
let rec name_of_type = function
| Int -> "int"
| Bits(i) -> sprintf "bit%d" i
| String -> "string"
| Vector(t, i_l) ->
    let in_str_type =
        if List.length i_l = 1 then
            name_of_type t
        else
            name_of_type (Vector(t, List.tl i_l)) in
    sprintf "v_%s" in_str_type
| Fun(_, _, _) -> raise(Dev_Error("we don't compare function"))
| Wild_Card(i) -> raise(Dev_Error("we don't compare wild_card"))
| Special(s) -> raise(Dev_Error("we don't compare special"))
;;

(* transform the name in clip to name in c, prevent '-'' *)
let c_name s =
    String.map (fun c -> if c = '-' then '_' else c) s
;;

(* transform the function name in clip to name in c
    prevent '-' and create the name for dynamic functions *)
let c_fun_name s t =
    if s = "if" then
        begin match t with
        | Fun(Fix, t1, [Bits(1); t2; t3]) ->
            sprintf "if__%s" (name_of_type t1)
        | _ -> raise(Dev_Error("eq's arguments not confirmed.")) end
    else if s = "eq" then
        begin match t with
        | Fun(Fix, Bits(1), [t1; t2]) ->
            sprintf "eq__%s" (name_of_type t1)
        | _ -> raise(Dev_Error("eq's arguments not confirmed.")) end
    else if s = "neq" then
        begin match t with
        | Fun(Fix, Bits(1), [t1; t2]) ->
            sprintf "neq__%s" (name_of_type t1)
        | _ -> raise(Dev_Error("neq's arguments not confirmed.")) end
    else if s = "^" then
        begin match t with
        | Fun(Fix, Bits(i), in_l) ->
            sprintf "xor__%d__%d" i (List.length in_l)
        | _ -> raise(Dev_Error("^'s arguments not confirmed.")) end
    else if s = "|" || s = "or" then
        begin match t with
        | Fun(Fix, Bits(i), in_l) ->
            sprintf "or__%d__%d" i (List.length in_l)
        | _ -> raise(Dev_Error("|'s arguments not confirmed.")) end
    else if s = "&" || s = "and" then
        begin match t with
        | Fun(Fix, Bits(i), in_l) ->
            sprintf "and__%d__%d" i (List.length in_l)
        | _ -> raise(Dev_Error("&'s arguments not confirmed.")) end
    else if s = "parity" then
        begin match t with
        | Fun(Fix, _, [Bits(i)]) -> sprintf "parity_%d" i
        | _ ->
            raise(Dev_Error("nit-of-bits' arguments not confirmed.")) end
    else if s = ">>>" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "rotate_r__%d" i
        | _ -> raise(Dev_Error(">>>'s arguments not confirmed.")) end
    else if s = "<<<" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "rotate_l__%d" i
        | _ -> raise(Dev_Error("<<<'s arguments not confirmed.")) end
    else if s = ">>" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "shift_r__%d" i
        | _ -> raise(Dev_Error(">>'s arguments not confirmed.")) end
    else if s = "<<" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "shift_l__%d" i
        | _ -> raise(Dev_Error("<<'s arguments not confirmed.")) end
    else if s = "flip-bit" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "%s__%d" (c_name s) i
        | _ -> raise(Dev_Error("<<'s arguments not confirmed.")) end
    else if s = "flip" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "%s__%d" (c_name s) i
        | _ -> raise(Dev_Error("<<'s arguments not confirmed.")) end
    else if s = "int-of-bits" then
        begin match t with
        | Fun(Fix, _, [Bits(i)]) -> sprintf "%s__%d" (c_name s) i
        | _ ->
            raise(Dev_Error("nit-of-bits' arguments not confirmed.")) end
    else if s = "string-of-bits" then
        begin match t with
        | Fun(Fix, _, [Bits(i)]) -> sprintf "%s__%d" (c_name s) i
        | _ ->  raise(Dev_Error
            ("string-of-bits' arguments not confirmed.")) end
    else if s = "bits-of-int" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "%s__%d" (c_name s) i
        | _ -> raise(Dev_Error
            ("bit-of-int's arguments not confirmed.")) end
    else if s = "bits-of-string" then
        begin match t with
        | Fun(Fix, Bits(i), _) -> sprintf "%s__%d" (c_name s) i
        | _ -> raise(Dev_Error
            ("bit-of-string's arguments not confirmed.")) end
    else if s = "pad" then
        begin match t with
        | Fun(Fix, Bits(i), [Bits(j); _]) ->
            sprintf "%s__%d__%d" (c_name s) i j
        | _ -> raise(Dev_Error
                ("pad's arguments not confirmed.")) end
    else if s = "+" then
        begin match t with
        | Fun(Fix, Int, [Int; Int]) -> "add2"
        | _ -> "add" end
    else if s = "*" then
        begin match t with
        | Fun(Fix, Int, [Int; Int]) -> "mul2"
        | _ -> "mul" end
    else if s = "-" then "subtract"
    else if s = "/" then "divide"
    else if s = "not" then "not__"
    else if s = "less" then "less__"
    else if s = "greater" then "greater__"
    else if s = "leq" then "leq__"
    else if s = "geq" then "geq__"
    else if s = "pow" then "power"
    else
        c_name s
;;

(* translate an expression into c code *)
let rec translate_expr indent ids = function
| Xint_Lit(s) -> sprintf
    "%sstring %s = \"%s\";\n"
    (str_ind indent) ids s
| Xbin_Lit(s) -> sprintf
    "%sstring %s = dec_of_bin(\"%s\");\n"
    (str_ind indent) ids s
| Xhex_Lit(s) -> sprintf
    "%sstring %s = dec_of_hex(\"%s\");\n"
    (str_ind indent) ids s
| Xbit_Binary_Lit(s, i) -> sprintf
    "%sbitset<%d> %s = bitset<%d>(string(\"%s\"));\n"
    (str_ind indent) i ids i s
| Xbit_Hex_Lit(s, i) -> sprintf
    "%sbitset<%d> %s = bitset<%d>(bin_of_hex(string(\"%s\")));\n"
    (str_ind indent) i ids i s
| Xstring_Lit(s) -> sprintf
    "%sstring %s = \"%s\";\n"
    (str_ind indent) ids s
| Xvector_Lit(xexpr_l) ->
    let len = List.length xexpr_l in
    let ele_dec_and_ele_l = (List.mapi (fun i x -> 
        id_counter := 1 + !id_counter;
        let ids = (sprintf "id__%d" !id_counter) in
        (translate_expr (1+indent) ids x), ids, i) xexpr_l) in
    let ele_dec = List.fold_left (fun s1 (ele_dec, _, _) -> sprintf "%s%s" s1 ele_dec) "" ele_dec_and_ele_l in
    let eles_assign = List.fold_left
        (fun s (_, ele, i) -> sprintf "%s%s%s[%d] = %s;\n" s (str_ind (indent+1)) ids i ele)
        ""
        ele_dec_and_ele_l in
    sprintf "%s%svector< %s > %s;\n%s%s.resize(%d);\n%s"
        ele_dec
        (str_ind indent) (string_of_type (Semantic.get_type (List.hd xexpr_l))) ids 
        (str_ind (indent+1)) ids len eles_assign
| Xid(s, t) -> begin match t with
    | Fun(Fix, out_t, in_t_l) ->
        let in_t_l_s = List.fold_left
            (fun s t -> sprintf "%s, %s" s (string_of_type t))
            (string_of_type (List.hd in_t_l))
            (List.tl in_t_l) in
        sprintf "%sfunction <%s (%s)> %s = &%s;\n"
        (str_ind indent) (string_of_type out_t) in_t_l_s ids (c_fun_name s t)
    | _ -> sprintf "%s%s %s = %s;\n"
        (str_ind indent) (string_of_type t) ids (c_name s) end    
| Xidd(s, xexpr_l, t) -> 
    let arg_dec_and_arg_l = (List.map (fun x -> 
        id_counter := 1 + !id_counter;
        let ids = (sprintf "id__%d" !id_counter) in
        (translate_expr (1+indent) ids x), ids) xexpr_l) in
    let args_dec = List.fold_left (fun s1 (arg_dec, _) -> sprintf "%s%s" s1 arg_dec) "" arg_dec_and_arg_l in
    let args_l = snd (List.split arg_dec_and_arg_l) in
    let vector_part_s = List.fold_left
        (fun s ids -> s ^ "[string_of_int(" ^ ids ^ ")]")
        ("[string_of_int(" ^ (List.hd args_l) ^ ")]")
        (List.tl args_l) in
    sprintf "%s%s%s %s = %s%s;\n"
    args_dec (str_ind indent)
    (string_of_type t) ids
    (c_name s) vector_part_s
| Xvec_Dimension(i) -> sprintf "%sstring %s = at__%d;\n" (str_ind indent) ids i
| Xlet(l_list, xexpr) ->
    let bind_s = List.fold_left
        (fun s (idt, xexp) ->
            id_counter := 1 + !id_counter;
            let var = (sprintf "id__%d" !id_counter) in
            let bind_s = translate_expr (indent+1) var xexp in
            let type_s = (string_of_type idt.t) in
            s ^ (sprintf("%s%s%s %s = %s;\n") bind_s (str_ind indent) type_s (c_name idt.id) var))
        ""
        l_list in
    id_counter := 1 + !id_counter;
    let var = (sprintf "id__%d" !id_counter) in
    let last_eval_s = translate_expr (indent+1) var xexpr in
    sprintf("%s%s%s%s %s = %s;\n")
        bind_s last_eval_s (str_ind indent) (string_of_type (Semantic.get_type xexpr)) ids var
| Xlambda(idt_l, xexpr, i) ->
    let return_t_s = string_of_type (Semantic.get_type xexpr) in
    let gen_idt_arg = (fun idt -> sprintf "%s %s" (string_of_type idt.t) idt.id) in
    let args_t = List.fold_left
        (fun s idt -> sprintf "%s, %s" s (string_of_type idt.t))
        (string_of_type (List.hd idt_l).t)
        (List.tl idt_l) in
    let args = List.fold_left
        (fun s idt -> sprintf "%s, %s" s (gen_idt_arg idt))
        (gen_idt_arg (List.hd idt_l))
        (List.tl idt_l) in
    id_counter := 1 + !id_counter;
    let ids' = (sprintf "id__%d" !id_counter) in
    sprintf "%sfunction<%s (%s)> %s = [&](%s) {\n%s%sreturn %s;\n%s};\n"
    (str_ind indent) return_t_s args_t ids args
    (translate_expr (indent+1) ids' xexpr) (str_ind (indent+1)) ids'
    (str_ind indent)
| Xmake_Vector(t, xe) ->
    let bt, dim_l = begin match t with
        | Vector(bt, dim_l) -> bt, dim_l
        | _ -> raise(Dev_Error("translate.Xmake_Vector")) end in
    let n_dim = List.length dim_l in
    let out_ts = (string_of_type (Vector(bt, dim_l))) in
    let ts = (string_of_type bt) in
    id_counter := 1 + !id_counter;
    let ids' = (sprintf "id__%d" !id_counter) in
    let exs = (translate_expr (indent+1) ids' xe) in
    let args = gen_make_vec_args n_dim in
    (sprintf "\n%sfunction< %s (%s)> __f =\n" 
        (str_ind indent) ts (string_repeat "string" n_dim)) ^
    (sprintf "%s[&](%s) {\n%s%sreturn %s; };\n\n"
        (str_ind indent) args exs (str_ind (indent+1)) ids') ^
    (sprintf "%s%s %s;\n%s\n%s")
        (str_ind indent) out_ts ids (init_vector indent ids dim_l)
        (for_make_vector indent dim_l) ^
    (sprintf "%s%s%s = __f(%s);\n"
        (str_ind (indent+n_dim)) ids
        (dim_ind_make_vec n_dim)
        (ind_arg_make_vec n_dim))
| Xfuncall(fun_name, xexpr_l, t, xexpr) ->
    if fun_name = "if" then (
        id_counter := 1 + !id_counter;
        let ids_bool = (sprintf "id__%d" !id_counter) in
        id_counter := 1 + !id_counter;
        let ids_true = (sprintf "id__%d" !id_counter) in
        id_counter := 1 + !id_counter;
        let ids_false = (sprintf "id__%d" !id_counter) in
        let bool_s = (translate_expr (1+indent) ids_bool (List.hd xexpr_l)) in
        (sprintf "%s%s %s;\n%s\n" 
            (str_ind indent) (string_of_type t) ids bool_s)^
        (sprintf"%sif( %s == bitset<1>(1)) {\n%s%s%s=%s;\n%s} else {\n%s%s%s=%s;\n%s}\n"
            (str_ind indent) ids_bool
            (translate_expr (1+indent) ids_true (List.nth xexpr_l 1) )
            (str_ind (indent+1)) ids ids_true (str_ind indent)
            (translate_expr (1+indent) ids_false (List.nth xexpr_l 2) )
            (str_ind (indent+1)) ids ids_false) (str_ind indent)
    ) else if fun_name = "set" then (
        id_counter := 1 + !id_counter;
        let ids_value = (sprintf "id__%d" !id_counter) in
        let cal_s = (translate_expr (1+indent) ids_value (List.nth xexpr_l 1)) in
        let s, setee = begin match List.hd xexpr_l with
            | Xid(s, _) -> (c_name s), (sprintf "%s%s = %s;\n"
                (str_ind indent) (c_name s) ids_value)
            | Xidd(s, xexpr_l, t) ->
                let arg_dec_and_arg_l = (List.map (fun x -> 
                    id_counter := 1 + !id_counter;
                    let ids = (sprintf "id__%d" !id_counter) in
                    (translate_expr (1+indent) ids x), ids) xexpr_l) in
                let args_dec = List.fold_left (fun s1 (arg_dec, _) -> sprintf "%s%s" s1 arg_dec) "" arg_dec_and_arg_l in
                let args_l = snd (List.split arg_dec_and_arg_l) in
                let vector_part_s = List.fold_left
                    (fun s ids -> s ^ "[string_of_int(" ^ ids ^ ")]")
                    ("[string_of_int(" ^ (List.hd args_l) ^ ")]")
                    (List.tl args_l) in
                ((c_name s)^vector_part_s, (sprintf "%s%s%s = %s;\n"
                    args_dec (str_ind indent) ((c_name s)^vector_part_s) ids_value))
            | _ -> raise(Dev_Error("can only set Xid")) end in
        (sprintf "%s" cal_s) ^
        (sprintf "%s" setee) ^
        (sprintf "%s%s %s = %s;\n"
            (str_ind indent) (string_of_type t) ids s)
    ) else
        let arg_dec_and_arg_l = (List.map (fun x -> 
            id_counter := 1 + !id_counter;
            let ids = (sprintf "id__%d" !id_counter) in
            (translate_expr (1+indent) ids x), ids) xexpr_l) in
        let args_dec = List.fold_left (fun s1 (arg_dec, _) -> sprintf "%s%s" s1 arg_dec) "" arg_dec_and_arg_l in
        let args = List.fold_left
            (fun s1 (_, arg) -> sprintf "%s, %s" s1 arg)
            (sprintf "%s" (snd (List.hd arg_dec_and_arg_l)))
            (List.tl arg_dec_and_arg_l) in

        args_dec ^
        if string_match (regexp "lambda_[0-9]+") fun_name 0 then begin
            id_counter := 1 + !id_counter;
            let ids' = (sprintf "id__%d" !id_counter) in
            sprintf "%s%s%s %s = %s (%s);\n"
                (translate_expr (1+indent) ids' xexpr)
                (str_ind indent) (string_of_type t) ids
                (c_fun_name ids' (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) args
            end
        else if (fun_name = "+" || fun_name = "*") && List.length xexpr_l <> 2 then
            let add_args = List.fold_left
                (fun s (_, arg) -> sprintf "%s, %s.c_str()" s arg) ""
                arg_dec_and_arg_l in
            sprintf "%s%s %s = %s (%d%s);\n"
                (str_ind indent) (string_of_type t) ids
                (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l)))
                (List.length xexpr_l)
                add_args
        else
            sprintf "%s%s %s = %s (%s);\n"
                (str_ind indent) (string_of_type t) ids
                (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) args
;;

(* translate an defvar into c code *)
let translate_defvar xdefvar =
    id_counter := 1 + !id_counter;
    let glovar = (sprintf "id__%d" !id_counter) in
    let decl_value = translate_expr 2 glovar xdefvar.xvbody in
    (* decl_var stores the type and variable name as a string *)
    let type_s = (string_of_type xdefvar.xvname.t) in
    
    sprintf "%s%s init_%s () {\n%s%sreturn %s;\n%s}\n%s %s = init_%s();\n"
        (str_ind 1) type_s glovar decl_value (str_ind 2) glovar 
        (str_ind 1) type_s (c_name xdefvar.xvname.id) glovar

(* translate an defun into c code *)
let translate_xdefun xdefun =
    let return_type = string_of_type xdefun.xfname.t in
    let gen_idt_arg = (fun idt -> sprintf "%s %s" (string_of_type idt.t) idt.id) in
    let args = List.fold_left
        (fun s idt -> sprintf "%s, %s" s (gen_idt_arg idt))
        (gen_idt_arg (List.hd xdefun.xfargu))
        (List.tl xdefun.xfargu) in
    id_counter := 1 + !id_counter;
    let return_id = (sprintf "id__%d" !id_counter) in
    let body = translate_expr 1 return_id xdefun.xfbody in
    sprintf("%s %s (%s) {\n%s\n    return %s;\n}")
    return_type (c_name xdefun.xfname.id) args body return_id

(* translate a "clip" into c code *)
let translate_clip = function
| Xexpr(xexpr, b) -> 
    id_counter := 1 + !id_counter;
    let ids = (sprintf "id__%d" !id_counter) in
    let calculation = translate_expr 1 ids xexpr in
    let c_xexpr_str = if b then
        begin match Semantic.get_type xexpr with
        | Int -> sprintf "%scout << %s << endl;\n" (str_ind 1) ids
        | Bits(i) -> sprintf "%sprintbit<%d>(%s);\ncout << endl;\n" (str_ind 1) i ids
        | String -> sprintf "%scout << %s << endl;\n" (str_ind 1) ids
        | Vector(t, i_l) -> sprintf "%s%scout << endl;\n" (cout_vector ids t i_l) (str_ind 1)
        | _ -> sprintf "    cout << \"%s is not printable yet.\" << endl;" ids end
    else
        "" in
    sprintf "{\n%s%s}" calculation c_xexpr_str
| Xdefvar(xdefvar) -> translate_defvar xdefvar
| Xdefun(xdefun) -> translate_xdefun xdefun
;;

let rec translate_program = function
| [] -> ""
| hd_clip::tl_clips -> translate_clip hd_clip ^ "\n" ^ translate_program tl_clips
;;

(* generate the dynamic built-in function in C *)
let rec gen_builtin_in_xexpr = function
| Xint_Lit(_)
| Xbin_Lit(_)
| Xhex_Lit(_)
| Xbit_Binary_Lit(_, _)
| Xbit_Hex_Lit(_, _)
| Xstring_Lit(_) -> ()
| Xvector_Lit(xe_l) -> List.iter gen_builtin_in_xexpr xe_l
| Xid(s, t) ->
    begin match t with
    | Fun(Fix, out_t, in_t_l) ->
        let fake_xexpr_l = List.map (Semantic.type_to_xexpr) in_t_l in
        gen_builtin_in_xexpr (Xfuncall(s, fake_xexpr_l ,out_t, Xint_Lit("123")))
    | _ -> () end
| Xidd(_, xexpr_l, _) -> List.iter gen_builtin_in_xexpr xexpr_l
| Xvec_Dimension(_) -> ()
| Xlet(let_arg_l, xe) ->
    List.iter (fun ( _, xexp) -> gen_builtin_in_xexpr xexp) let_arg_l;
    gen_builtin_in_xexpr xe
| Xlambda (idt_l, xe, i) ->
    gen_builtin_in_xexpr xe
| Xmake_Vector(t, xe) -> gen_builtin_in_xexpr xe
| Xfuncall(fun_name, xexpr_l, t, xexpr) ->
    List.iter gen_builtin_in_xexpr xexpr_l;
    let in_t = (List.map Semantic.get_type xexpr_l) in
    if string_match (regexp "lambda_[0-9]+") fun_name 0 then
        gen_builtin_in_xexpr xexpr

    else if string_match (regexp "if") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            fprintf dyna_out "%s\n" (gen_if (name_of_type t) (string_of_type t)))

    else if string_match (regexp "eq") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match in_t with
            | [t1; t2] -> fprintf dyna_out "%s\n" (gen_eq (name_of_type t1) (string_of_type t1))
            | _ -> raise(Dev_Error("output of function eq should be bits")) end)

    else if string_match (regexp "neq") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match in_t with
            | [t1; t2] -> fprintf dyna_out "%s\n" (gen_neq (name_of_type t1) (string_of_type t1))
            | _ -> raise(Dev_Error("output of function neq should be bits")) end)

    else if string_match (regexp "\\^") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_xor i (List.length xexpr_l))
            | _ -> raise(Dev_Error("output of function ^ should be bits")) end)
    
    else if (string_match (regexp "|") fun_name 0) || fun_name = "or" then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_or i (List.length xexpr_l))
            | _ -> raise(Dev_Error("output of function | should be bits")) end)

    else if (string_match (regexp "&") fun_name 0) || fun_name = "and" then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_and i (List.length xexpr_l))
            | _ -> raise(Dev_Error("output of function & should be bits")) end)

    else if string_match (regexp "parity") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match in_t with
            | [Bits(i)] -> fprintf dyna_out "%s\n" (gen_parity i)
            | _ -> raise(Dev_Error("input of function int-of-bits should be bits")) end)

    else if string_match (regexp "map__[0-9]+") fun_name 0 then
        let f_in_type = Semantic.get_type (List.nth xexpr_l 1) in
        let f_in_type_s = string_of_type (decrease_dim f_in_type) in
        let f_out_type_s = string_of_type (decrease_dim t) in
        fprintf dyna_out "%s\n" (gen_map f_out_type_s fun_name f_in_type_s)
    
    else if string_match (regexp "merge__[0-9]+") fun_name 0 then
        begin match Semantic.get_type (List.hd xexpr_l) with
        | Vector(Bits(i), [len]) ->
            fprintf dyna_out "%s\n" (gen_merge (len*i) fun_name i)
        | _ -> raise(Dev_Error("wrong input of function merge not detected")) end
    
    else if string_match (regexp "group__[0-9]+") fun_name 0 then
        let in_t = Semantic.get_type (List.hd xexpr_l) in
        begin match in_t, t with
        | Bits(in_len),  Vector(Bits(out_len), _) ->
            fprintf dyna_out "%s\n" (gen_group out_len fun_name in_len)
        | _ -> raise(Dev_Error("wrong input of function group not detected")) end
    
    else if string_match (regexp "transpose__[0-9]+") fun_name 0 then
        begin match t with
        | Vector(t', [_; _]) ->
            fprintf dyna_out "%s\n" (gen_transpose (string_of_type t') fun_name)
        | _ -> raise(Dev_Error("wrong input of function transpose not detected")) end

    else if string_match (regexp "reduce__[0-9]+") fun_name 0 then
        let f_in_type = Semantic.get_type (List.nth xexpr_l 1) in
        let f_in_type_s = string_of_type (decrease_dim f_in_type) in
        let f_out_type_s = string_of_type t in
        fprintf dyna_out "%s\n" (gen_reduce f_out_type_s fun_name f_in_type_s)
    
    else if string_match (regexp ">>>") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_rotate_r i)
            | _ -> raise(Dev_Error("output of function >>> should be bits")) end)
    
    else if string_match (regexp "<<<") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_rotate_l i)
            | _ -> raise(Dev_Error("output of function <<< should be bits")) end)

    else if string_match (regexp ">>") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_shift_r i)
            | _ -> raise(Dev_Error("output of function >> should be bits")) end)
    
    else if string_match (regexp "<<") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_shift_l i)
            | _ -> raise(Dev_Error("output of function << should be bits")) end)

    else if string_match (regexp "flip-bit") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_flip_bit i)
            | _ -> raise(Dev_Error("output of function flip-bit should be bits")) end)

    else if string_match (regexp "flip") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_flip i)
            | _ -> raise(Dev_Error("output of function flip should be bits")) end)
    
    else if string_match (regexp "zero__[0-9]+") fun_name 0 then
        begin match t with
        | Bits(i) -> fprintf dyna_out "%s\n" (gen_zero i fun_name)
        | _ -> raise(Dev_Error("output of function zeros should be bits")) end
    
    else if string_match (regexp "rand__[0-9]+") fun_name 0 then
        begin match t with
        | Bits(i) -> fprintf dyna_out "%s\n" (gen_rand i fun_name)
        | _ -> raise(Dev_Error("output of function rand should be bits")) end
    
    else if string_match (regexp "int-of-bits") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match in_t with
            | [Bits(i)] -> fprintf dyna_out "%s\n" (gen_int_of_bits i)
            | _ -> raise(Dev_Error("input of function int-of-bits should be bits")) end)

    else if string_match (regexp "string-of-bits") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match in_t with
            | [Bits(i)] -> fprintf dyna_out "%s\n" (gen_string_of_bits i)
            | _ -> raise(Dev_Error("input of function string-of-bits should be bits")) end)

    else if string_match (regexp "bits-of-int") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_bits_of_int i)
            | _ -> raise(Dev_Error("output of function bits-of-int should be bits")) end)

    else if string_match (regexp "bits-of-string") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t with
            | Bits(i) -> fprintf dyna_out "%s\n" (gen_bits_of_string i)
            | _ -> raise(Dev_Error("output of function bits-of-string should be bits")) end)
    
    else if string_match (regexp "pad") fun_name 0 then
        let fun_name = (c_fun_name fun_name (Fun(Fix, t, List.map Semantic.get_type xexpr_l))) in
        let already = FunSet.mem fun_name !fun_db in
        if already then
            ()
        else
            (fun_db := FunSet.add fun_name !fun_db;
            begin match t, List.hd in_t with
            | Bits(i), Bits(j) -> fprintf dyna_out "%s\n" (gen_pad i j)
            | _ -> raise(Dev_Error("output of function pad should be bits")) end)

    else ()
;;

let gen_builtin_in_clip = function
| Xexpr(xexpr, _) -> gen_builtin_in_xexpr xexpr
| Xdefvar(xdefvar) -> gen_builtin_in_xexpr xdefvar.xvbody
| Xdefun(xdefun) -> gen_builtin_in_xexpr xdefun.xfbody
;;

let gen_builtin_in_program p =
    List.iter gen_builtin_in_clip p
;;

let translate_to_c program =
    fprintf dyna_out "#include <cstdlib>\n#include <ctime>\n#include <vector>\n#include <bitset>\n\nusing namespace std;\n\nvoid init(){srand(time(NULL));}\n\n";
    (gen_builtin_in_program program);
    (c_header_generator c_header_list) ^
    "using namespace std;\n\n" ^
    let def_l, exp_l = List.partition (fun c ->
        match c with
        | Xexpr(xexpr, _) -> false
        | _ -> true) program in
    (translate_program def_l) ^
    c_main_left ^
    (translate_program exp_l) ^
    c_main_right
;;


end