Compare commits

..

No commits in common. "e75d525a6dd5ddded277fec344681300541e2e9f" and "79f0c7d22349a8401029fc2fd51c893e7d724b23" have entirely different histories.

6 changed files with 55 additions and 133 deletions

View File

@ -9,12 +9,12 @@ let print_debug d s =
let print_verbose v s = let print_verbose v s =
if v then Format.printf "\x1b[33;01;04mStatus:\x1b[0m %s\n" s else () if v then Format.printf "\x1b[33;01;04mStatus:\x1b[0m %s\n" s else ()
let exec_passes ast main_fn verbose debug passes f = let exec_passes ast verbose debug passes f =
let rec aux ast = function let rec aux ast = function
| [] -> f ast | [] -> f ast
| (n, p) :: passes -> | (n, p) :: passes ->
verbose (Format.asprintf "Executing pass %s:\n" n); verbose (Format.asprintf "Executing pass %s:\n" n);
match p verbose debug main_fn ast with match p verbose debug ast with
| None -> (exit_error ("Error while in the pass "^n^".\n"); exit 0) | None -> (exit_error ("Error while in the pass "^n^".\n"); exit 0)
| Some ast -> ( | 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 Pp.pp_ast ast);
@ -25,17 +25,15 @@ let exec_passes ast main_fn verbose debug passes f =
let _ = let _ =
(** Usage and argument parsing. *) (** Usage and argument parsing. *)
let default_passes = ["chkvar_init_unicity"; "pre2vars"; "linearization"] in let default_passes = ["chkvar_init_unicity"; "pre2vars"] in
let usage_msg = let usage_msg =
"Usage: main [-passes p1,...,pn] [-ast] [-verbose] [-debug] \ "Usage: main [-passes p1,...,pn] [-ast] [-verbose] [-debug] \
[-o output_file] [-m main_function] source_file\n" in [-o output_file] source_file\n" in
let verbose = ref false in let verbose = ref false in
let debug = ref false in let debug = ref false in
let ppast = ref false in let ppast = ref false in
let nopopt = ref false in let nopopt = ref false in
let simopt = ref false in
let passes = ref [] in let passes = ref [] in
let main_fn = ref "main" in
let source_file = ref "" in let source_file = ref "" in
let output_file = ref "out.c" in let output_file = ref "out.c" in
let anon_fun filename = source_file := filename in let anon_fun filename = source_file := filename in
@ -47,9 +45,6 @@ let _ =
("-debug", Arg.Set debug, "Output a lot of debug information"); ("-debug", Arg.Set debug, "Output a lot of debug information");
("-p", Arg.String (fun s -> passes := s :: !passes), ("-p", Arg.String (fun s -> passes := s :: !passes),
"Add a pass to the compilation process"); "Add a pass to the compilation process");
("-sim", Arg.Set simopt, "Simulate the main node");
("-m", Arg.String (fun s -> main_fn := s),
"Defines what the main function is (defaults to main).");
("-o", Arg.Set_string output_file, "Output file (defaults to [out.c])"); ("-o", Arg.Set_string output_file, "Output file (defaults to [out.c])");
] in ] in
Arg.parse speclist anon_fun usage_msg ; Arg.parse speclist anon_fun usage_msg ;
@ -57,7 +52,6 @@ let _ =
if !passes = [] then passes := default_passes; if !passes = [] then passes := default_passes;
let print_verbose = print_verbose !verbose in let print_verbose = print_verbose !verbose in
let print_debug = print_debug !debug in let print_debug = print_debug !debug in
let main_fn = !main_fn in
(** Definition of the passes table *) (** Definition of the passes table *)
let passes_table = Hashtbl.create 100 in let passes_table = Hashtbl.create 100 in
@ -65,7 +59,6 @@ let _ =
[ [
("pre2vars", Passes.pre2vars); ("pre2vars", Passes.pre2vars);
("chkvar_init_unicity", Passes.chkvar_init_unicity); ("chkvar_init_unicity", Passes.chkvar_init_unicity);
("linearization", Passes.pass_linearization);
]; ];
(** Main functionality below *) (** Main functionality below *)
@ -108,11 +101,7 @@ let _ =
print_debug (Format.asprintf "Initial AST (before executing any passes):\n%a" print_debug (Format.asprintf "Initial AST (before executing any passes):\n%a"
Pp.pp_ast ast) ; Pp.pp_ast ast) ;
exec_passes ast main_fn print_verbose print_debug passes exec_passes ast print_verbose print_debug passes
begin
if !simopt
then Simulation.simulate main_fn
else
begin begin
if !ppast if !ppast
then (Format.printf "%a" Pp.pp_ast) then (Format.printf "%a" Pp.pp_ast)
@ -121,5 +110,4 @@ let _ =
then (fun _ -> ()) then (fun _ -> ())
else Format.printf "%a" Ast_to_c.ast_to_c) else Format.printf "%a" Ast_to_c.ast_to_c)
end end
end

View File

@ -161,12 +161,6 @@
%token<bool> CONST_BOOL %token<bool> CONST_BOOL
%token<Ast.real> CONST_REAL %token<Ast.real> CONST_REAL
%left MO_not
%left MO_pre
%left PLUS
%left MINUS
%left BO_and BO_or BO_mul BO_div BO_mod BO_arrow BO_fby TO_merge
/* The Entry Point */ /* The Entry Point */
%start main %start main
%type <Ast.t_nodelist> main %type <Ast.t_nodelist> main
@ -201,12 +195,7 @@ node_content:
n_automata = aut; n_automata = aut;
n_inputs_type = t_in; n_inputs_type = t_in;
n_outputs_type = t_out; } in n_outputs_type = t_out; } in
if Hashtbl.find_opt defined_nodes node_name <> None Hashtbl.add defined_nodes node_name n; n };
then raise (MyParsingError
(Format.asprintf "The node %s is already defined."
node_name,
current_location()))
else Hashtbl.add defined_nodes node_name n; n };
node_body: node_body:
| /* empty */ { ([], []) } | /* empty */ { ([], []) }

View File

@ -1,9 +1,40 @@
(** This file contains simplification passes for our Lustre-like AST *) (** This file contains simplification passes for our Lustre-like AST *)
open Ast open Ast
open Passes_utils
let pre2vars verbose debug main_fn = (** [node_pass] is an auxiliary function used to write passes: it will iterate
* the function passed as argument on all the nodes of the program *)
let node_pass f ast: t_nodelist option =
Utils.list_map_option f ast
(** [equation_pass] is an auxiliary function used to write passes: it will
* iterate the function passed as argument on all the equations of the
* program *)
let equation_pass f ast: t_nodelist option =
let aux (node: t_node): t_node option =
match Utils.list_map_option f node.n_equations with
| None -> None
| Some eqs -> Some {n_name = node.n_name;
n_inputs = node.n_inputs;
n_outputs = node.n_outputs;
n_local_vars = node.n_local_vars;
n_equations = eqs;
n_automata = node.n_automata;
n_inputs_type = node.n_inputs_type;
n_outputs_type = node.n_outputs_type;
}
in
node_pass aux ast
let expression_pass f: t_nodelist -> t_nodelist option =
let aux (patt, expr) =
match f expr with
| None -> None
| Some expr -> Some (patt, expr)
in
equation_pass aux
let pre2vars verbose debug =
let rec all_pre expr = let rec all_pre expr =
match expr with match expr with
| EMonOp (ty, MOp_pre, expr) -> all_pre expr | EMonOp (ty, MOp_pre, expr) -> all_pre expr
@ -84,7 +115,7 @@ let pre2vars verbose debug main_fn =
in in
expression_pass (Utils.somify aux) expression_pass (Utils.somify aux)
let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option = let chkvar_init_unicity verbose debug : t_nodelist -> t_nodelist option =
let aux (node: t_node) : t_node option = let aux (node: t_node) : t_node option =
let incr_aux h n = let incr_aux h n =
match Hashtbl.find_opt h n with match Hashtbl.find_opt h n with
@ -98,7 +129,9 @@ let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option
| [] -> () | [] -> ()
| eq :: eqs -> (incr_eq h eq; incr_eqlist h eqs) | eq :: eqs -> (incr_eq h eq; incr_eqlist h eqs)
in in
let incr_branch h (State (_, eqs, _, _): t_state) = incr_eqlist h eqs in let incr_branch h (State (_, eqs, _, _): t_state) = incr_eqlist h eqs in
let incr_automata h ((_, states): t_automaton) = let incr_automata h ((_, states): t_automaton) =
let acc = Hashtbl.copy h in let acc = Hashtbl.copy h in
List.iter List.iter
@ -113,6 +146,7 @@ let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option
) h_st) states; ) h_st) states;
Hashtbl.iter (fun v n -> Hashtbl.replace h v n) acc Hashtbl.iter (fun v n -> Hashtbl.replace h v n) acc
in in
let check_now h : bool= let check_now h : bool=
Hashtbl.fold Hashtbl.fold
(fun varname num old_res -> (fun varname num old_res ->
@ -127,6 +161,9 @@ let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option
then (verbose (Format.asprintf "Purging %s" varname); Hashtbl.remove h varname) then (verbose (Format.asprintf "Purging %s" varname); Hashtbl.remove h varname)
else ()) h else ()) h
in*) in*)
let h = Hashtbl.create Config.maxvar in let h = Hashtbl.create Config.maxvar in
let add_var n v = let add_var n v =
match v with match v with
@ -139,6 +176,8 @@ let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option
List.iter add_var_in (snd node.n_inputs); List.iter add_var_in (snd node.n_inputs);
List.iter add_var_loc (snd node.n_outputs); List.iter add_var_loc (snd node.n_outputs);
List.iter add_var_loc (snd node.n_local_vars); List.iter add_var_loc (snd node.n_local_vars);
(** Usual Equations *) (** Usual Equations *)
incr_eqlist h node.n_equations; incr_eqlist h node.n_equations;
if check_now h = false if check_now h = false
@ -151,43 +190,7 @@ let chkvar_init_unicity verbose debug main_fn : t_nodelist -> t_nodelist option
else None else None
end end
(** never purge -> failwith never executed! purge_initialized h; *) (** never purge -> failwith never executed! purge_initialized h; *)
in in
node_pass aux node_pass aux
let pass_linearization verbose debug main_fn =
let node_lin (node: t_node): t_node option =
let rec tpl ((pat, exp): t_equation) =
match exp with
| ETuple (_, hexps :: texps) ->
let p1, p2 =
Utils.list_select
(List.length (Utils.type_exp hexps))
(snd pat) in
let t1 = List.flatten (List.map Utils.type_var p1) in
let t2 = List.flatten (List.map Utils.type_var p2) in
((t1, p1), hexps)
:: (tpl ((t2, p2),
ETuple (List.flatten (List.map Utils.type_exp texps), texps)))
| ETuple (_, []) -> []
| _ -> [(pat, exp)]
in
let new_locvars = node.n_local_vars in
let new_equations = List.flatten
begin
List.map
tpl
node.n_equations
end in
Some
{
n_name = node.n_name;
n_inputs = node.n_inputs;
n_outputs = node.n_outputs;
n_local_vars = new_locvars;
n_equations = new_equations;
n_automata = node.n_automata;
n_inputs_type = node.n_inputs_type;
n_outputs_type = node.n_outputs_type;
}
in
node_pass node_lin

View File

@ -1,33 +0,0 @@
open Ast
(** [node_pass] is an auxiliary function used to write passes: it will iterate
* the function passed as argument on all the nodes of the program *)
let node_pass f ast: t_nodelist option =
Utils.list_map_option f ast
(** [equation_pass] is an auxiliary function used to write passes: it will
* iterate the function passed as argument on all the equations of the
* program *)
let equation_pass (f: t_equation -> t_equation option) ast: t_nodelist option =
let aux (node: t_node): t_node option =
match Utils.list_map_option f node.n_equations with
| None -> None
| Some eqs -> Some {n_name = node.n_name;
n_inputs = node.n_inputs;
n_outputs = node.n_outputs;
n_local_vars = node.n_local_vars;
n_equations = eqs;
n_automata = node.n_automata;
n_inputs_type = node.n_inputs_type;
n_outputs_type = node.n_outputs_type;
}
in
node_pass aux ast
let expression_pass f: t_nodelist -> t_nodelist option =
let aux (patt, expr) =
match f expr with
| None -> None
| Some expr -> Some (patt, expr)
in
equation_pass aux

View File

@ -1,4 +0,0 @@
node diagonal_int (i: int) returns (o1, o2 : int);
let
(o1, o2) = (i, i);
tel

View File

@ -1,14 +1,5 @@
open Ast open Ast
let rec list_select n = function
| [] -> [], []
| h :: t ->
if n = 0
then ([], h :: t)
else
let p1, p2 = list_select (n-1) t in
h :: p1, p2
let rec list_map_option (f: 'a -> 'b option) (l: 'a list) : 'b list option = let rec list_map_option (f: 'a -> 'b option) (l: 'a list) : 'b list option =
List.fold_right (fun elt acc -> List.fold_right (fun elt acc ->
match acc, f elt with match acc, f elt with
@ -48,15 +39,3 @@ let name_of_var: t_var -> ident = function
| IVar s -> s | IVar s -> s
| BVar s -> s | BVar s -> s
| RVar s -> s | RVar s -> s
let rec fresh_var_name (l: t_varlist) n : ident =
let rec aux acc n =
let r = Random.int 26 in
Format.asprintf "%c%s"
(char_of_int (r + (if Random.bool () then 65 else 97)))
(if n = 0 then acc else aux acc (n-1))
in
let name = aux "" n in
if List.filter (fun v -> name_of_var v = name) (snd l) = []
then name
else fresh_var_name l n