diff --git a/src/ast_to_c.ml b/src/ast_to_c.ml index 0789b76..f98ffa3 100644 --- a/src/ast_to_c.ml +++ b/src/ast_to_c.ml @@ -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 diff --git a/src/cprint.ml b/src/cprint.ml index a64e8fa..5f191ae 100644 --- a/src/cprint.ml +++ b/src/cprint.ml @@ -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. *) diff --git a/src/cast.ml b/src/intermediate_ast.ml similarity index 100% rename from src/cast.ml rename to src/intermediate_ast.ml diff --git a/src/c_utils.ml b/src/intermediate_utils.ml similarity index 98% rename from src/c_utils.ml rename to src/intermediate_utils.ml index 717b4a5..c964e50 100644 --- a/src/c_utils.ml +++ b/src/intermediate_utils.ml @@ -1,4 +1,4 @@ -open Cast +open Intermediate_ast let rec find_app_opt eqs i = let rec find_app_expr_opt i = function diff --git a/src/pp.ml b/src/lustre_pp.ml similarity index 100% rename from src/pp.ml rename to src/lustre_pp.ml diff --git a/src/main.ml b/src/main.ml index 7acfc16..80c3678 100644 --- a/src/main.ml +++ b/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) - 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 diff --git a/src/simulation.ml b/src/simulation.ml deleted file mode 100644 index e7ba3db..0000000 --- a/src/simulation.ml +++ /dev/null @@ -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 - diff --git a/src/test.node b/tests/test.node similarity index 100% rename from src/test.node rename to tests/test.node diff --git a/src/test2.node b/tests/test2.node similarity index 100% rename from src/test2.node rename to tests/test2.node diff --git a/src/test_pre.node b/tests/test_pre.node similarity index 100% rename from src/test_pre.node rename to tests/test_pre.node