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

[general] renaming (pp -> lustre_pp ; c_* -> intermediate_*)

Browse Source
This commit is contained in:
dsac 2022-12-17 21:26:32 +01:00
parent 916c7f544b
commit 3cbfaeb2a8
10 changed files with 57 additions and 130 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
src/ast_to_c.ml
View File

@ -1,6 +1,6 @@
open Ast
open Cast
open C_utils
open Intermediate_ast
open Intermediate_utils
open Cprint
open Utils
@ -56,7 +56,6 @@ let ast_to_cast (nodes: t_nodelist) (h: node_states): c_nodelist =
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: node_states =
@ -198,21 +197,26 @@ let make_state_types nodes: node_states =
(** 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
match (Hashtbl.find h node.cn_name).nt_prevars with
| [] -> ()
| l ->
Format.fprintf fmt
"\n\t/* Remember the values used in the [pre] construct */\n";
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)
l
(** 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
@ -220,7 +224,7 @@ let cp_init_aux_nodes fmt (node, h) =
| 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"
\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)
@ -235,12 +239,33 @@ let cp_init_aux_nodes fmt (node, h) =
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"
(** The following function prints one equation of the program into a set of
* instruction ending in assignments. *)
let cp_equation fmt (eq, hloc) =
Format.fprintf fmt "\t\t/* TODO! */\n"
(** [cp_equations] prints the node equations. *)
let rec cp_equations fmt (eqs, hloc) =
match eqs with
| [] -> ()
| eq :: eqs ->
Format.fprintf fmt "%a%a"
cp_equation (eq, hloc)
cp_equations (eqs, hloc)
(** [cp_node] prints a single node *)
let cp_node fmt (node, h) =
Format.fprintf fmt "%a\n{\n%a%a\n\n\tstate->is_init = false;\n%a}\n"
cp_prototype (node, h)
cp_init_aux_nodes (node, h)
cp_equations (node.cn_equations, Hashtbl.find h node.cn_name)
cp_prevars (node, h)
(** [cp_nodes] recursively prints all the nodes of a program. *)
let rec cp_nodes fmt (nodes, h) =
match nodes with
| [] -> ()
@ -251,6 +276,7 @@ let rec cp_nodes fmt (nodes, h) =
(** main function that prints a C-code from a term of type [t_nodelist]. *)
let ast_to_c prog =
let prog_st_types = make_state_types prog in
let prog: c_nodelist = ast_to_cast prog prog_st_types in

4
src/cprint.ml
View File

@ -1,5 +1,5 @@
open C_utils
open Cast
open Intermediate_utils
open Intermediate_ast
open Ast
(** This file contains extrimely simple functions printing C code. *)

0
src/cast.ml → src/intermediate_ast.ml
View File

2
src/c_utils.ml → src/intermediate_utils.ml
View File

@ -1,4 +1,4 @@
open Cast
open Intermediate_ast
let rec find_app_opt eqs i =
let rec find_app_expr_opt i = function

0
src/pp.ml → src/lustre_pp.ml
View File

31
src/main.ml
View File

@ -17,7 +17,7 @@ let exec_passes ast main_fn verbose debug passes f =
match p verbose debug main_fn ast with
| None -> (exit_error ("Error while in the pass "^n^".\n"); exit 0)
| Some ast -> (
debug (Format.asprintf "Current AST (after %s):\n%a\n" n Pp.pp_ast ast);
debug (Format.asprintf "Current AST (after %s):\n%a\n" n Lustre_pp.pp_ast ast);
aux ast passes)
in
aux ast passes
@ -34,7 +34,6 @@ let _ =
let debug = ref false in
let ppast = ref false in
let nopopt = ref false in
let simopt = ref false in
let passes = ref [] in
let source_file = ref "" in
let testopt = ref false in
@ -51,7 +50,6 @@ let _ =
("-debug", Arg.Set debug, "Output a lot of debug information");
("-p", Arg.String (fun s -> passes := s :: !passes),
"Add a pass to the compilation process");
("-sim", Arg.Set simopt, "Simulate the main node");
("-o", Arg.Set_string output_file, "Output file (defaults to [out.c])");
] in
Arg.parse speclist anon_fun usage_msg ;
@ -93,7 +91,7 @@ let _ =
begin
close_in_noerr inchan;
Format.printf "Syntax error at %a: %s\n\n"
Pp.pp_loc (l, !source_file) s;
Lustre_pp.pp_loc (l, !source_file) s;
exit 0
end
| Parsing.Parse_error ->
@ -101,7 +99,7 @@ let _ =
close_in_noerr inchan;
Parsing.(
Format.printf "Syntax error at %a\n\n"
Pp.pp_loc ((symbol_start_pos (), symbol_end_pos()), !source_file));
Lustre_pp.pp_loc ((symbol_start_pos (), symbol_end_pos()), !source_file));
exit 0
end
in
@ -121,19 +119,14 @@ let _ =
in
print_debug (Format.asprintf "Initial AST (before executing any passes):\n%a"
Pp.pp_ast ast) ;
Lustre_pp.pp_ast ast) ;
exec_passes ast main_fn print_verbose print_debug passes
begin
if !simopt
then Simulation.simulate main_fn
else
begin
if !ppast
then (Format.printf "%a" Pp.pp_ast)
else (
if !nopopt
then (fun _ -> ())
else Ast_to_c.ast_to_c)
end
end
begin
if !ppast
then (Format.printf "%a" Lustre_pp.pp_ast)
else (
if !nopopt
then (fun _ -> ())
else Ast_to_c.ast_to_c)
end

92
src/simulation.ml
View File

@ -1,92 +0,0 @@
open Ast
type sim_var =
| SIVar of ident * (int option)
| SBVar of ident * (bool option)
| SRVar of ident * (real option)
type sim_node_st =
{
node_outputs: sim_var list;
node_loc_vars: sim_var list;
node_inner_nodes: sim_node list;
}
and sim_node_step_fn =
sim_node_st -> sim_var list -> (sim_var list * sim_node_st)
and sim_node = sim_node_st * sim_node_step_fn
let pp_sim fmt ((sn, _): sim_node) =
let rec aux fmt vars =
match vars with
| [] -> ()
| SIVar (s, None) :: t ->
Format.fprintf fmt "\t<%s : int> uninitialized yet.\n%a" s aux t
| SBVar (s, None) :: t ->
Format.fprintf fmt "\t<%s : bool> uninitialized yet.\n%a" s aux t
| SRVar (s, None) :: t ->
Format.fprintf fmt "\t<%s : real> uninitialized yet.\n%a" s aux t
| SIVar (s, Some i) :: t ->
Format.fprintf fmt "\t<%s : int> = %d\n%a" s i aux t
| SBVar (s, Some b) :: t ->
Format.fprintf fmt "\t<%s : bool> = %s\n%a" s (Bool.to_string b) aux t
| SRVar (s, Some r) :: t ->
Format.fprintf fmt "\t<%s : real> = %f\n%a" s r aux t
in
if sn.node_loc_vars <> []
then
Format.fprintf fmt "State of the simulated node:\n\
\tOutput variables:\n%a
\tLocal variables:\n%a"
aux sn.node_outputs
aux sn.node_loc_vars
else
Format.fprintf fmt "State of the simulated node:\n\
\tOutput variables:\n%a
\tThere are no local variables:\n"
aux sn.node_outputs
exception MySimulationException of string
let fetch_node (p: t_nodelist) (s: ident) : t_node =
match List.filter (fun n -> n.n_name = s) p with
| [e] -> e
| _ -> raise (MySimulationException (Format.asprintf "Node %s undefined." s))
let fetch_var (l: sim_var list) (s: ident) =
match List.filter
(function
| SBVar (v, _) | SRVar (v, _) | SIVar (v, _) -> v = s) l with
| [v] -> v
| _ -> raise (MySimulationException
(Format.asprintf "Variable %s undefined." s))
(** TODO! *)
let make_sim (main_fn: ident) (p: t_nodelist): sim_node =
let main_n = fetch_node p main_fn in
let node_outputs =
List.map
(function
| IVar s -> SIVar (s, None)
| BVar s -> SBVar (s, None)
| RVar s -> SRVar (s, None))
(snd main_n.n_outputs) in
let node_loc_vars: sim_var list =
List.map
(function
| IVar s -> SIVar (s, None)
| BVar s -> SBVar (s, None)
| RVar s -> SRVar (s, None))
(snd main_n.n_local_vars) in
let node_inner_nodes = (* TODO! *) [] in
({node_outputs = node_outputs;
node_loc_vars = node_loc_vars;
node_inner_nodes = node_inner_nodes; },
(fun s l -> (s.node_outputs, s)))
let simulate main_fn ast =
let sim_ast = make_sim main_fn ast in
Format.printf "Initial state:\n%a" pp_sim sim_ast

0
src/test.node → tests/test.node
View File

0
src/test2.node → tests/test2.node
View File

0
src/test_pre.node → tests/test_pre.node
View File