diff --git a/src/ast_to_c.ml b/src/ast_to_c.ml index b8f3715..3bd4c28 100644 --- a/src/ast_to_c.ml +++ b/src/ast_to_c.ml @@ -315,9 +315,10 @@ let ast_to_c verbose debug prog = let prog_st_types = make_state_types prog in debug (Format.asprintf "%a" dump_var_locations prog_st_types); let iprog: i_nodelist = ast_to_intermediate_ast prog prog_st_types in - Format.printf "%a\n\n%a\n\n/* Nodes: */\n%a%a\n" + Format.printf "%a\n\n%a\n\n%a\n\n/* Nodes: */\n%a%a\n" cp_includes (Config.c_includes) cp_state_types prog_st_types + cp_state_frees (iprog, prog_st_types) cp_nodes (iprog, prog_st_types) cp_main_fn (prog, prog_st_types) diff --git a/src/cprint.ml b/src/cprint.ml index 20a96a5..a4d8064 100644 --- a/src/cprint.ml +++ b/src/cprint.ml @@ -40,6 +40,79 @@ let cp_state_types fmt (h: (ident, node_state) Hashtbl.t): unit = Format.fprintf fmt "/* Struct holding states of the node %s: */\n%a" n cp_node_state nst) h + + +(** [cp_state_frees] prints the required code to recursively free the node + * states. *) +let cp_state_frees fmt (iprog, sts) = + let rec find_callee (i: int) (f: i_node) = + let rec aux_expr = function + | IETuple [] | IEVar _ | IEConst _ -> None + | IEMonOp (_, e) -> aux_expr e + | IEWhen (e, e') + | IEReset (e, e') + | IEComp (_, e, e') + | IEBinOp (_, e, e') -> + begin + match aux_expr e with + | None -> aux_expr e' + | Some res -> Some res + end + | IETriOp (_, e, e', e'') -> + begin + match aux_expr e with + | None -> + (match aux_expr e' with + | None -> aux_expr e'' + | Some res -> Some res) + | Some res -> Some res + end + | IETuple (h :: t) -> + begin + match aux_expr h with + | None -> aux_expr (IETuple t) + | Some res -> Some res + end + | IEApp (j, n, e) -> + if i = j + then Some n.n_name + else aux_expr e + in + List.fold_right + (fun (_, expr) acc -> + match acc with + | Some _ -> acc + | None -> aux_expr expr) + f.in_equations None + in + let rec cp_free_aux fmt (i, caller_name) = + let idx = i - 1 in + match find_callee i (List.find (fun n -> n.in_name = caller_name) iprog)with + | None -> () + | Some callee_name -> + let callee_st = Hashtbl.find sts callee_name in + if callee_st.nt_count_app > 0 then + Format.fprintf fmt "\tif (st->aux_states[%d])\n\ + \t\tfree_state_%s(st->aux_states + %d);\n" + idx callee_name idx; + Format.fprintf fmt "\tif (st->aux_states[%d])\n\ + \t\tfree(st->aux_states[%d]);\n%a" + idx idx cp_free_aux (i+1, caller_name) + in + Hashtbl.iter + (fun node_name node_st -> + if node_st.nt_count_app = 0 + then () (** Nothing to free for the node [node_name]. *) + else + Format.fprintf fmt "void free_state_%s(t_state_%s *st)\n\ + {\n\ + %a\ + }\n" + node_name node_name + cp_free_aux (1, node_name)) sts + + + let cp_var' fmt = function | CVStored (arr, idx) -> Format.fprintf fmt "state->%s[%d]" arr idx | CVInput s -> Format.fprintf fmt "%s" s @@ -75,6 +148,13 @@ let rec cp_varlist fmt vl = print_if_any vl cp_varlist vl + + +(** [cp_prototype] prints functions prototypes (without the «;»). It is only + * used to write the beginning of functions right now. If we later allow to + * use auxiliary nodes before their definition, it might be useful to declare + * all the prototypes at the beginning of the file (Cf. [cp_prototypes] below. + *) let cp_prototype fmt (node, h): unit = match Hashtbl.find_opt h node.in_name with | None -> failwith "This should not happened!" @@ -96,6 +176,10 @@ let rec cp_prototypes fmt ((nodes, h): i_nodelist * node_states) = +(** [cp_value] prints values, that is unary or binary operations which can be + * inlined in the final code without requiring many manipulations. + * It uses a lot of parenthesis at the moment. An improvement would be to + * remove useless ones at some point. *) let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) = let string_of_binop = function | BOp_add -> "+" @@ -146,6 +230,8 @@ let rec cp_value fmt (value, (hloc: (ident * bool, string * int) Hashtbl.t)) = | CMonOp (MOp_pre, _) -> failwith "The linearization should have removed this case." + + let prefix_ = ref "\t" (** The following function prints one transformed equation of the program into a @@ -317,6 +403,12 @@ let cp_main_fn fmt (prog, sts) = s (Format.sprintf "_char_of_%s" s) cp_char_to_bool vl in + let cp_free fmt () = + let main_st = Hashtbl.find sts "main" in + if main_st.nt_count_app = 0 + then () + else Format.fprintf fmt "\tfree_state_main(&st)\n" + in match List.find_opt (fun n -> n.n_name = "main") prog with | None -> () | Some node -> @@ -333,10 +425,12 @@ let cp_main_fn fmt (prog, sts) = \t\tfn_main(&state, %a);\n\ \t\tprintf(%a);\n\ \t}\n\ - \treturn EXIT_SUCCESS;\n\ + %a\treturn EXIT_SUCCESS;\n\ }\n" cp_array (snd node.n_inputs) cp_scanf (snd node.n_inputs) cp_char_to_bool (snd node.n_inputs) cp_inputs (false, snd node.n_inputs) cp_printf (snd node.n_outputs) + cp_free () + diff --git a/src/test.node b/src/test.node index 3c3e9a8..6f83475 100644 --- a/src/test.node +++ b/src/test.node @@ -1,5 +1,18 @@ -node main (i: int) returns (a, b: int); +node id_int (i: int) returns (o: int); let - (a, b) = (i, i); + o = i -> i; +tel + +node aux (i, j: int) returns (o: int); +let + o = id_int(i) + id_int(j); +tel + +node main (i: int) returns (a, b: int); +var tmp: int; +let + a = 1; + b = aux (i, a); + tmp = aux (a+b, i); tel