diff --git a/src/ast_to_c.ml b/src/ast_to_c.ml index 4bfdd9b..0789b76 100644 --- a/src/ast_to_c.ml +++ b/src/ast_to_c.ml @@ -1,20 +1,72 @@ open Ast +open Cast open C_utils open Cprint open Utils +(** [ast_to_cast] translates a [t_nodelist] into a [c_nodelist] *) +let ast_to_cast (nodes: t_nodelist) (h: node_states): c_nodelist = + let c = ref 1 in + let ast_to_cast_varlist vl = snd vl in + let rec ast_to_cast_expr hloc = function + | EVar (_, v) -> + begin + match Hashtbl.find_opt hloc (v, false) with + | None -> CVar (CVInput (name_of_var v)) + | Some (s, i) -> CVar (CVStored (s, i)) + end + | EMonOp (_, op, e) -> CMonOp (op, ast_to_cast_expr hloc e) + | EBinOp (_, op, e, e') -> + CBinOp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') + | ETriOp (_, op, e, e', e'') -> + CTriOp + (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e', ast_to_cast_expr hloc e'') + | EComp (_, op, e, e') -> + CComp (op, ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') + | EWhen (_, e, e') -> + CWhen (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') + | EReset (_, e, e') -> + CReset (ast_to_cast_expr hloc e, ast_to_cast_expr hloc e') + | EConst (_, c) -> CConst c + | ETuple (_, l) -> CTuple (List.map (ast_to_cast_expr hloc) l) + | EApp (_, n, e) -> + begin + let e = ast_to_cast_expr hloc e in + let res = CApp (!c, n, e) in + let () = incr c in + res + end + in + let ast_to_cast_eq hloc (patt, expr) : c_equation = + (ast_to_cast_varlist patt, ast_to_cast_expr hloc expr) in + List.map + begin + fun node -> + let () = c := 1 in + let hloc = (Hashtbl.find h node.n_name).nt_map in + { + cn_name = node.n_name; + cn_inputs = ast_to_cast_varlist node.n_inputs; + cn_outputs = ast_to_cast_varlist node.n_outputs; + cn_local_vars = ast_to_cast_varlist node.n_local_vars; + cn_equations = List.map (ast_to_cast_eq hloc) node.n_equations; + } + end + nodes + + (** The following function defines the [node_states] for the nodes of a program, * and puts them in a hash table. *) -let make_state_types nodes: (ident, node_state) Hashtbl.t = +let make_state_types nodes: node_states = (* Hash table to fill *) let h: (ident, node_state) Hashtbl.t = Hashtbl.create (List.length nodes) in (** [one_node node pv ty] computes the number of variables of type [ty] in * [node] and a mapping from the variables of type ([ty] * bool) to int, * where [pv] is a list of variables used in the pre construct in the - * programm. *) + * program. *) let one_node node pv ty = (* variables of type [ty] among output and local variables *) let vars = @@ -35,8 +87,8 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t = (** [find_prevars n] returns the list of variables appearing after a pre in * the node [n]. - * Note that the only occurence of pre are of the form pre (var), due to the - * linearization pass. + * Note that the only occurrence of pre are of the form pre (var), due to + * the linearization pass. *) let find_prevars node = let rec find_prevars_expr = function @@ -58,6 +110,26 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t = [] node.n_equations) in + (** [count_app n] count the number of auxiliary nodes calls in [n] *) + let count_app n = + let rec count_app_expr = function + | EConst _ | EVar _ -> 0 + | EMonOp (_, _, e) -> count_app_expr e + | ETriOp (_, _, e, e', e'') -> + (count_app_expr e) + (count_app_expr e') + (count_app_expr e'') + | EComp (_, _, e, e') + | EBinOp (_, _, e, e') + | EWhen (_, e, e') + | EReset (_, e, e') -> (count_app_expr e) + (count_app_expr e') + | ETuple (_, l) -> + List.fold_left (fun acc e -> acc + count_app_expr e) 0 l + | EApp (_, _, e) -> 1 + count_app_expr e + in + List.fold_left + (fun i (_, expr) -> i + count_app_expr expr) + 0 n.n_equations + in + (** [aux] iterates over all nodes of the program to build the required hash * table *) let rec aux nodes = @@ -109,6 +181,7 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t = nt_map = h_map; nt_output_map = h_out; nt_prevars = pv; + nt_count_app = count_app node; } in h end @@ -117,14 +190,72 @@ let make_state_types nodes: (ident, node_state) Hashtbl.t = -(*let ast_to_c*) +(** The following C-printer functions are in this file, as they need to work on + * the AST and are not simple printers. *) + + + +(** The following function prints the code to remember previous values of + * variables used with the pre construct. *) +let cp_prevars fmt (node, h) = + Format.fprintf fmt + "\n\t/* Remember the values of variables used in the [pre] construct */\n"; + let node_st = Hashtbl.find h node.cn_name in + List.iter + (fun v -> (** Note that «dst_array = src_array» should hold. *) + let (src_array, src_idx) = Hashtbl.find node_st.nt_map (v, false) in + let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in + Format.fprintf fmt "\t%s[%d] = %s[%d];\n" + dst_array dst_idx src_array src_idx) + node_st.nt_prevars + +(** The following function defines the behaviour to have at the first + * execution of a node, namely: + * - initialize the states of auxiliary nodes + * *) +let cp_init_aux_nodes fmt (node, h) = + let rec aux fmt (node, nst, i) = + match find_app_opt node.cn_equations i with + | None -> () (** All auxiliary nodes have been initialized *) + | Some n -> + begin + Format.fprintf fmt "%a\t\tstate->aux_states[%d] = malloc (sizeof (%s));\n\ + \t\t(%s*)(state->aux_states[%d])->is_init = true;\n" + aux (node, nst, i-1) + (i-1) (Format.asprintf "t_state_%s" n.n_name) + (Format.asprintf "t_state_%s" n.n_name) (i-1) + end + in + let nst = Hashtbl.find h node.cn_name in + if nst.nt_count_app = 0 + then () + else begin + Format.fprintf fmt "\t/* Initialize the auxiliary nodes */\n\ + \tif (state->is_init) {\n%a\t}\n" + aux (node, nst, nst.nt_count_app) + end + +let rec cp_node fmt (node, h) = + Format.fprintf fmt "%a\n{\n%a\t\tTODO...\n\n\tstate->is_init = false;\n%a}\n" + cp_prototype (node, h) + cp_init_aux_nodes (node, h) + cp_prevars (node, h) + +let rec cp_nodes fmt (nodes, h) = + match nodes with + | [] -> () + | node :: nodes -> + Format.fprintf fmt "%a\n%a" + cp_node (node, h) + cp_nodes (nodes, h) let ast_to_c prog = let prog_st_types = make_state_types prog in - Format.printf "%s\n\n%a\n\n/* Node Prototypes: */\n%a\n\n/* Nodes: */\n%a" - Config.c_includes + let prog: c_nodelist = ast_to_cast prog prog_st_types in + Format.printf "%a\n\n%a\n\n/* Node Prototypes: */\n%a\n\n/* Nodes: */\n%a" + cp_includes (Config.c_includes) cp_state_types prog_st_types cp_prototypes (prog, prog_st_types) cp_nodes (prog, prog_st_types) diff --git a/src/c_utils.ml b/src/c_utils.ml index 26ba5e1..717b4a5 100644 --- a/src/c_utils.ml +++ b/src/c_utils.ml @@ -1,39 +1,42 @@ -open Ast - -(** A node state is translated into a struct. This struct has: - * 1. A name (t_state_) - * 2. A number of local and output variables of each type (int, real, bool) - * 3-5. mappings that maps - * [(variable, is_pre)] to an index of the corresponding array (see below) - * where [variable] is of type [t_var], and [is_pre] indicated whether we - * deal with pre (x) or x. - * 6. A mapping mapping any variable to the name of the C table containing it - * and the index at which it is stored (= union of the tables [nt_map_*]) - * 7. A mapping mapping the output number i to its location (name of the - * table that contains it and index. - * - * Important Note: if a variable x appears behind a pre, it will count as two - * variables in the point 2. above.. - * - * It should be translated as follow in C: - typedef struct { - int ivars[nt_nb_int]; (or nothing if nt_nb_int = 0) - int bvars[nt_nb_bool]; (or nothing if nt_nb_bool = 0) - int rvars[nt_nb_real]; (or nothing if nt_nb_real = 0) - bool is_init; - } t_state_; - *) -type node_state = - { - nt_name: string; - nt_nb_int : int; - nt_nb_real: int; - nt_nb_bool: int; - nt_map_int: (t_var * bool, int) Hashtbl.t; - nt_map_bool: (t_var * bool, int) Hashtbl.t; - nt_map_real: (t_var * bool, int) Hashtbl.t; - nt_map: (t_var * bool, string * int) Hashtbl.t; - nt_output_map: (int, string * int) Hashtbl.t; - nt_prevars: t_var list - } +open Cast +let rec find_app_opt eqs i = + let rec find_app_expr_opt i = function + | CVar _ | CConst _ -> None + | CMonOp (_, e) -> find_app_expr_opt i e + | CReset (e, e') | CWhen (e, e') | CComp (_, e, e') | CBinOp (_, e, e') -> + begin + match find_app_expr_opt i e with + | None -> find_app_expr_opt i e' + | Some n -> Some n + end + | CTriOp (_, e, e', e'') -> + begin + match find_app_expr_opt i e with + | None -> + begin + match find_app_expr_opt i e' with + | None -> find_app_expr_opt i e'' + | Some n -> Some n + end + | Some n -> Some n + end + | CTuple l -> + List.fold_left + (fun acc e -> + match acc, find_app_expr_opt i e with + | Some n, _ -> Some n + | None, v -> v) + None l + (** [CApp] below represents the n-th call to an aux node *) + | CApp (j, n, e) -> + if i = j + then Some n + else find_app_expr_opt i e + in + match eqs with + | [] -> None + | (_, expr) :: eqs -> + match find_app_expr_opt i expr with + | None -> find_app_opt eqs i + | Some n -> Some n diff --git a/src/cast.ml b/src/cast.ml new file mode 100644 index 0000000..31a4dc7 --- /dev/null +++ b/src/cast.ml @@ -0,0 +1,78 @@ +open Ast + +(** A node state is translated into a struct. This struct has: + * 1. A name (t_state_) + * 2. A number of local and output variables of each type (int, real, bool) + * 3-5. mappings that maps + * [(variable, is_pre)] to an index of the corresponding array (see below) + * where [variable] is of type [t_var], and [is_pre] indicated whether we + * deal with pre (x) or x. + * 6. A mapping mapping any variable to the name of the C table containing it + * and the index at which it is stored (= union of the tables [nt_map_*]) + * 7. A mapping mapping the output number i to its location (name of the + * table that contains it and index. + * + * Important Note: if a variable x appears behind a pre, it will count as two + * variables in the point 2. above.. + * + * It should be translated as follow in C: + typedef struct { + int ivars[nt_nb_int]; (or nothing if nt_nb_int = 0) + int bvars[nt_nb_bool]; (or nothing if nt_nb_bool = 0) + int rvars[nt_nb_real]; (or nothing if nt_nb_real = 0) + bool is_init; + } t_state_; + *) +type node_state = + { + nt_name: string; + nt_nb_int : int; + nt_nb_real: int; + nt_nb_bool: int; + nt_map_int: (t_var * bool, int) Hashtbl.t; + nt_map_bool: (t_var * bool, int) Hashtbl.t; + nt_map_real: (t_var * bool, int) Hashtbl.t; + nt_map: (t_var * bool, string * int) Hashtbl.t; + nt_output_map: (int, string * int) Hashtbl.t; + nt_prevars: t_var list; + nt_count_app: int; + } + + + +type c_var = + | CVStored of string * int + | CVInput of ident + +type c_expression = + | CVar of c_var + | CMonOp of monop * c_expression + | CBinOp of binop * c_expression * c_expression + | CTriOp of triop * c_expression * c_expression * c_expression + | CComp of compop * c_expression * c_expression + | CWhen of c_expression * c_expression + | CReset of c_expression * c_expression + | CConst of const + | CTuple of (c_expression list) + (** [CApp] below represents the n-th call to an aux node *) + | CApp of int * t_node * c_expression + +and c_varlist = t_var list + +and c_equation = c_varlist * c_expression + +and c_eqlist = c_equation list + +and c_node = + { + cn_name : ident; + cn_inputs: c_varlist; + cn_outputs: c_varlist; + cn_local_vars: c_varlist; + cn_equations: c_eqlist; + } + +type c_nodelist = c_node list + +type node_states = (ident, node_state) Hashtbl.t + diff --git a/src/config.ml b/src/config.ml index 7761b61..1ad7133 100644 --- a/src/config.ml +++ b/src/config.ml @@ -3,4 +3,4 @@ * variables. *) let maxvar = 100 -let c_includes = "#include " +let c_includes = ["stdbool"; "stdlib"] diff --git a/src/cprint.ml b/src/cprint.ml index bbfc952..a64e8fa 100644 --- a/src/cprint.ml +++ b/src/cprint.ml @@ -1,17 +1,38 @@ open C_utils +open Cast open Ast +(** This file contains extrimely simple functions printing C code. *) + +let rec cp_includes fmt = function + | [] -> () + | h :: t -> + Format.fprintf fmt "#include <%s>\n%a" h cp_includes t + let cp_node_state fmt (st: node_state) = let maybeprint fmt (ty, nb, name): unit = if nb = 0 then () else Format.fprintf fmt "\n\t%s %s[%d];" ty name nb in - Format.fprintf fmt "typedef struct {%a%a%a\n\tbool is_init;\n} %s;\n\n" - maybeprint ("int", st.nt_nb_int, "ivars") - maybeprint ("bool", st.nt_nb_bool, "bvars") - maybeprint ("double", st.nt_nb_real, "rvars") - st.nt_name + if st.nt_count_app = 0 + then + Format.fprintf fmt "typedef struct {%a%a%a\n\ + \tbool is_init;\n\ + } %s;\n\n" + maybeprint ("int", st.nt_nb_int, "ivars") + maybeprint ("bool", st.nt_nb_bool, "bvars") + maybeprint ("double", st.nt_nb_real, "rvars") + st.nt_name + else + Format.fprintf fmt "typedef struct {%a%a%a\n\ + \tbool is_init;\n\ + \tvoid* aux_states[%d]; /* stores the states of auxiliary nodes */\n\ + } %s;\n\n" + maybeprint ("int", st.nt_nb_int, "ivars") + maybeprint ("bool", st.nt_nb_bool, "bvars") + maybeprint ("double", st.nt_nb_real, "rvars") + st.nt_count_app st.nt_name let cp_state_types fmt (h: (ident, node_state) Hashtbl.t): unit = Hashtbl.iter (fun n nst -> @@ -37,17 +58,17 @@ let rec cp_varlist fmt vl = cp_varlist vl let cp_prototype fmt (node, h): unit = - match Hashtbl.find_opt h node.n_name with + match Hashtbl.find_opt h node.cn_name with | None -> failwith "This should not happend!" | Some nst -> begin - Format.fprintf fmt "void %s (%s *state, %a)" - node.n_name + Format.fprintf fmt "void fn_%s (%s *state, %a)" + node.cn_name nst.nt_name - cp_varlist (snd node.n_inputs) + cp_varlist node.cn_inputs end -let rec cp_prototypes fmt (nodes, h) = +let rec cp_prototypes fmt ((nodes, h): c_nodelist * node_states) = match nodes with | [] -> () | node :: nodes -> @@ -55,29 +76,3 @@ let rec cp_prototypes fmt (nodes, h) = cp_prototype (node, h) cp_prototypes (nodes, h) -(** The ollowing function prints the code to remember previous values of - * variables used with the pre construct. *) -let cp_prevars fmt (node, h) = - Format.fprintf fmt - "\n\t/* Remember the values of variables used in the [pre] construct */\n"; - let node_st = Hashtbl.find h node.n_name in - List.iter - (fun v -> (** Note that «dst_array = src_array» should hold. *) - let (src_array, src_idx) = Hashtbl.find node_st.nt_map (v, false) in - let (dst_array, dst_idx) = Hashtbl.find node_st.nt_map (v, true) in - Format.fprintf fmt "\t%s[%d] = %s[%d];\n" - dst_array dst_idx src_array src_idx) - node_st.nt_prevars - -let rec cp_node fmt (node, h) = - Format.fprintf fmt "%a\n{\n\t\tTODO...\n\n\tstate->is_init = false;\n%a}\n" - cp_prototype (node, h) - cp_prevars (node, h) - -let rec cp_nodes fmt (nodes, h) = - match nodes with - | [] -> () - | node :: nodes -> - Format.fprintf fmt "%a\n%a" - cp_node (node, h) - cp_nodes (nodes, h) diff --git a/src/test2.node b/src/test2.node index 2c60962..2a4f0b3 100644 --- a/src/test2.node +++ b/src/test2.node @@ -1,5 +1,11 @@ -node main (i: int) returns (o1: int); +node diagonal_int (i: int) returns (o1, o2 : int); let - o1 = 10 -> pre (20 -> 30); + (o1, o2) = (i, i); +tel + +node main (i: int) returns (o1, o2, o3, o4: int); +let + (o1, o2) = diagonal_int(i); + (o3, o4) = diagonal_int(o1); tel