195 lines
No EOL
6.3 KiB
OCaml
195 lines
No EOL
6.3 KiB
OCaml
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 <stdio.h>
|
|
#include <stdlib.h>
|
|
|
|
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 ());;*) |