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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

145
src/ast_to_c.ml
View File

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

79
src/c_utils.ml
View File

@ -1,39 +1,42 @@
open Ast
(** A node state is translated into a struct. This struct has:
* 1. A name (t_state_<name of the node>)
* 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_<node name>;
*)
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

78
src/cast.ml Normal file
View File

@ -0,0 +1,78 @@
open Ast
(** A node state is translated into a struct. This struct has:
* 1. A name (t_state_<name of the node>)
* 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_<node name>;
*)
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

2
src/config.ml
View File

@ -3,4 +3,4 @@
* variables. *)
let maxvar = 100
let c_includes = "#include <stdbool.h>"
let c_includes = ["stdbool"; "stdlib"]

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)

10
src/test2.node
View File

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