Benjamin_Loison/Synchronous_reactive_systems
1
0
Fork 0
Code Issues 7 Pull Requests Packages Projects Releases Wiki Activity

[ast2C] initialize states of auxiliary nodes.

Browse Source
This commit is contained in:
dsac
2022-12-17 18:34:11 +01:00
parent 6291957be5
commit 916c7f544b
6 changed files with 297 additions and 84 deletions
Download Patch File Download Diff File Expand all files Collapse all files

67
src/cprint.ml
View File

@@ -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)