[general] renaming (pp -> lustre_pp ; c_* -> intermediate_*)
This commit is contained in:
parent
916c7f544b
commit
3cbfaeb2a8
@ -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
|
||||
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)
|
||||
node_st.nt_prevars
|
||||
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
|
||||
|
@ -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. *)
|
||||
|
@ -1,4 +1,4 @@
|
||||
open Cast
|
||||
open Intermediate_ast
|
||||
|
||||
let rec find_app_opt eqs i =
|
||||
let rec find_app_expr_opt i = function
|
17
src/main.ml
17
src/main.ml
@ -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)
|
||||
then (Format.printf "%a" Lustre_pp.pp_ast)
|
||||
else (
|
||||
if !nopopt
|
||||
then (fun _ -> ())
|
||||
else Ast_to_c.ast_to_c)
|
||||
end
|
||||
end
|
||||
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user