open Printf;; open Int;; open StringLabels;; let counter = ref 0;; let gensym = fun () -> (let tmp = Printf.sprintf "sym%d" (!counter) in counter := !counter + 1; tmp) (* let ex_token_list = Tokenizer.total_parser "lambda(x){x;}(12);";; Parser.print_parseoutput (Parser.stmts ex_token_list);;*) let ex_token_list2 = Tokenizer.total_parser "((lambda(int x){lambda(int y){x + y;};}(7))(8));";; let ex_parseoutput2 = Parser.stmts ex_token_list2;; let infering_result = Type_inf.type_infer ex_parseoutput2;; (*type infering*) let ex_parseoutput3 = Parser.Ls(Closure_conv.closure_conv_main ex_parseoutput2);; (*closure_conversion*) print_string (Parser.ast2string ex_parseoutput3);; let list_mut = ref (Parser.Ls([]));; let main_str = ref "";; let closure_counter = ref (-1);; let get_args_sym_string x = match x with | Parser.Ls([Parser.Item(Tokenizer.Token(arg_typ, "ID")); Parser.Item(Tokenizer.Token(arg_sym, "ID"))]) -> arg_sym | _ -> "" let rec codegen ast_tree main_str = match ast_tree with | Parser.Ls([Parser.Item(Tokenizer.Token(op, "OP")); x; y]) -> let a = codegen_aux ast_tree main_str in (!main_str, a) | Parser.Ls([Parser.Item(Tokenizer.Token("%apply", "ID")); x; y]) -> let a = codegen_aux ast_tree main_str in (!main_str, a) | Parser.Ls(ls_inner) -> let a = (List.map (fun x -> codegen_aux x main_str) ls_inner) in (!main_str, (List.hd (List.rev a))) | Parser.Item(x) -> let a = codegen_aux ast_tree main_str in (a, a) | Parser.ASTFail -> ("", "") and codegen_aux ast_tree main_str= match ast_tree with | Parser.Ls([Parser.Item(Tokenizer.Token("%apply", "ID")); caller; callee]) -> let caller_side = codegen_aux caller main_str in let callee_side = codegen_aux callee main_str in let res_sym = gensym () in let fmt = format_of_string " Object %s; %s = %s.value.func(%s, %s.free_var); " in let item_str = Printf.sprintf fmt res_sym res_sym caller_side callee_side caller_side in main_str := !(main_str) ^ item_str; res_sym | Parser.Item(Tokenizer.Token(num, "INT")) -> let sym = (gensym ()) in let fmt = format_of_string " Object %s; %s.type =\"int\"; %s.value.inte = %d;\n" in let item_str = Printf.sprintf fmt sym sym sym (int_of_string num) in main_str := !(main_str) ^ item_str; sym | Parser.Ls([Parser.Item(Tokenizer.Token("lambda", "ID")); Parser.Ls(args_id::args); body ]) -> let closure_con = !closure_counter in let args_str_array = List.map get_args_sym_string args in let arg_str = List.hd args_str_array in let function_str = ref "" in let (body_string, get_return_id) = codegen body function_str in let sym_lambda = gensym () in let sym_closure = gensym () in let return_str = "return " ^ get_return_id ^ ";" in let fmt = format_of_string " Object %s (Object %s, Object* fv){ %s %s } " in let item_str_tmp = Printf.sprintf fmt sym_lambda arg_str body_string return_str in let closure_str_fmt = format_of_string " %s Object %s; %s.type= \"func\"; %s.value.func = &%s; %s.free_var = clos%d ; " in let item_str = Printf.sprintf closure_str_fmt item_str_tmp sym_closure sym_closure sym_closure sym_lambda sym_closure closure_con in main_str := !(main_str) ^ item_str ; sym_closure | Parser.Item(Tokenizer.Token(var, "ID")) -> main_str := !(main_str) ^ "\t" ^ var ^ ";"; var | Parser.Ls([Parser.Item(Tokenizer.Token("+", "OP")); x; y]) -> let sym = (gensym ()) in let lhs = codegen_aux x main_str in let rhs = codegen_aux y main_str in let fmt = format_of_string " Object %s; %s.type = %s.type; if (%s.type = \"int\"){ %s.value.inte = %s.value.inte + %s.value.inte;} else if (%s.type = \"flo\"){ %s.value.doub = %s.value.doub + %s.value.doub; } %s;\n" in let item_str = (Printf.sprintf fmt sym sym lhs lhs sym lhs rhs sym sym lhs rhs sym) in let _ = (main_str := !(main_str) ^ item_str ) in sym | Parser.Ls([Parser.Item(Tokenizer.Token("%def", "ID")); Parser.Item(Tokenizer.Token("STRUCT", "ID")) ; Parser.Item(Tokenizer.Token(clo_fv, "ID")) ; Parser.Ls(Parser.Item(Tokenizer.Token("%struct", "ID"))::fv_list)]) -> (*let fv_list = List.tl fv_ls in (*fv = free variable*)*) let fv_string_list = List.map (fun x -> match x with |Parser.Item(Tokenizer.Token(x, "ID"))-> x |_ -> "") fv_list in let result_rhs = "{" ^ (List.fold_right (fun x y -> x ^ ", " ^ y) fv_string_list "") ^ "}" in let fmt = format_of_string " Object %s[] = %s;\n\n" in let item_str = (Printf.sprintf fmt clo_fv result_rhs) in let _ = (main_str := !(main_str) ^ item_str ) in let _ = closure_counter := !closure_counter + 1 in "" | Parser.Ls([Parser.Item(Tokenizer.Token("%def", "ID")); typ; Parser.Item(Tokenizer.Token(lhs, "ID")); y]) -> let rhs = codegen_aux y main_str in let fmt = format_of_string " Object %s; %s.type = %s.type; if (%s.type = \"int\"){ %s.value.inte = %s.value.inte;} else if (%s.type = \"flo\"){ %s.value.doub = %s.value.doub; } else{ %s.value.func = %s.value.func; }\n" in let item_str = (Printf.sprintf fmt lhs lhs rhs lhs lhs rhs lhs lhs rhs lhs rhs) in let _ = (main_str := !(main_str) ^ item_str ) in "" | Parser.Ls([Parser.Ls(inner)]) -> (codegen_aux (Parser.Ls(inner)) main_str) | _ -> "0";; let (output_var_string, _) = codegen ex_parseoutput3 main_str;; let print_main str = let preamble = format_of_string " #include #include typedef struct Object Object; typedef union ObjectValue{ int inte; double doub; char *str; Object (*func) (Object, Object*); } ObjectValue; typedef struct Object{ char* type; ObjectValue value; Object* free_var; } Object; int main() { %s return 0;} " in Printf.sprintf preamble str;; (*print_string output_var_string;; *) print_string (print_main output_var_string);; (* Printf.printf "%s" (gensym ());; Printf.printf "%s" (gensym ());; Printf.printf "%s" (gensym ());;*)