Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
src/tools/stateflow/sf_sem.ml | ||
---|---|---|
1 |
|
|
2 |
|
|
3 | 1 |
type backend = GenLus | GenImp |
4 | 2 |
|
5 | 3 |
(* Model choice *) |
6 | 4 |
let model_name = ref "simple" |
7 | 5 |
|
8 |
let models = [(module Model_simple : Datatype.MODEL_T); |
|
9 |
(module Model_stopwatch : Datatype.MODEL_T); |
|
10 |
(* (module Model_medium : Datatype.MODEL_T)*) |
|
11 |
] |
|
12 |
let get_model_name m = let module M = (val m : Datatype.MODEL_T) in M.name |
|
13 |
let set_model name = |
|
6 |
let models = |
|
7 |
[ |
|
8 |
(module Model_simple : Datatype.MODEL_T); |
|
9 |
(module Model_stopwatch : Datatype.MODEL_T); |
|
10 |
(* (module Model_medium : Datatype.MODEL_T)*) |
|
11 |
] |
|
12 |
|
|
13 |
let get_model_name m = |
|
14 |
let module M = (val m : Datatype.MODEL_T) in |
|
15 |
M.name |
|
16 |
|
|
17 |
let set_model name = |
|
14 | 18 |
if List.exists (fun n -> get_model_name n = name) models then |
15 | 19 |
model_name := name |
16 |
else failwith ("incorrect model name. Use " ^ |
|
17 |
(List.fold_left (fun r n -> r ^ " or " ^ get_model_name n) "" models)) |
|
20 |
else |
|
21 |
failwith |
|
22 |
("incorrect model name. Use " |
|
23 |
^ List.fold_left (fun r n -> r ^ " or " ^ get_model_name n) "" models) |
|
18 | 24 |
|
19 | 25 |
(* Backend selection *) |
20 | 26 |
let modular = ref 0 |
27 |
|
|
21 | 28 |
let set_modular i = modular := i |
22 | 29 |
|
23 | 30 |
let mode = ref GenLus |
24 |
|
|
25 |
|
|
26 |
let set_mode m = |
|
27 |
mode := m |
|
31 |
|
|
32 |
let set_mode m = mode := m |
|
28 | 33 |
|
29 | 34 |
(* Main *) |
30 |
|
|
31 |
let options = [ |
|
32 |
"-verbose", Arg.Set_int Options.verbose_level, "changes verbose \x1b[4mlevel\x1b[0m <default: 1>"; |
|
33 |
"-model", Arg.String set_model, "model in {simple, stopwatch} (default: simple)"; |
|
34 |
(* "-eval", Arg.Int set_trace_run_mode, "execute the model on trace <int>"; *) |
|
35 |
(* "-eval-mode", Arg.String set_eval_mode, "select evaluator: cps"; *) |
|
36 |
"-gen_c", Arg.Unit (fun _ -> set_mode GenImp), "generate imperative code"; |
|
37 |
"-gen_lustre", Arg.Unit (fun _ -> set_mode GenLus), "generate lustre model"; |
|
38 |
"-modular", Arg.Int set_modular, "generate modular code (either for imperative or lustre backend) 0 is not modular, 1 modularize nodes, 2 modularize entry, during and exit actions (default 0)" |
|
39 |
] |
|
35 |
|
|
36 |
let options = |
|
37 |
[ |
|
38 |
( "-verbose", |
|
39 |
Arg.Set_int Options.verbose_level, |
|
40 |
"changes verbose \x1b[4mlevel\x1b[0m <default: 1>" ); |
|
41 |
( "-model", |
|
42 |
Arg.String set_model, |
|
43 |
"model in {simple, stopwatch} (default: simple)" ); |
|
44 |
(* "-eval", Arg.Int set_trace_run_mode, "execute the model on trace <int>"; *) |
|
45 |
(* "-eval-mode", Arg.String set_eval_mode, "select evaluator: cps"; *) |
|
46 |
"-gen_c", Arg.Unit (fun _ -> set_mode GenImp), "generate imperative code"; |
|
47 |
"-gen_lustre", Arg.Unit (fun _ -> set_mode GenLus), "generate lustre model"; |
|
48 |
( "-modular", |
|
49 |
Arg.Int set_modular, |
|
50 |
"generate modular code (either for imperative or lustre backend) 0 is \ |
|
51 |
not modular, 1 modularize nodes, 2 modularize entry, during and exit \ |
|
52 |
actions (default 0)" ); |
|
53 |
] |
|
40 | 54 |
|
41 | 55 |
let usage = |
42 |
"lustresf [JSON file] takes as input a stateflow model in the JSON format and a backend.\n"^ |
|
43 |
"Backends are eother the C code generator or the lustre code generator." |
|
56 |
"lustresf [JSON file] takes as input a stateflow model in the JSON format \ |
|
57 |
and a backend.\n" |
|
58 |
^ "Backends are eother the C code generator or the lustre code generator." |
|
44 | 59 |
|
45 |
|
|
46 | 60 |
let _ = |
47 | 61 |
Arg.parse options (fun _ -> ()) usage; |
48 | 62 |
let model = List.find (fun m -> get_model_name m = !model_name) models in |
49 | 63 |
let modularmode = |
50 | 64 |
match !modular with |
51 |
| 2 -> true, true, true |
|
52 |
| 1 -> false, true, false |
|
53 |
| _ (* 0 *) -> false, false ,false |
|
65 |
| 2 -> |
|
66 |
true, true, true |
|
67 |
| 1 -> |
|
68 |
false, true, false |
|
69 |
| _ (* 0 *) -> |
|
70 |
false, false, false |
|
54 | 71 |
in |
55 | 72 |
match !mode with |
56 |
| GenImp -> (
|
|
73 |
| GenImp -> |
|
57 | 74 |
let module Model = (val model) in |
58 | 75 |
let module T = CPS_ccode_generator.CodeGenerator in |
59 | 76 |
let module Sem = CPS.Semantics (T) (Model) in |
60 | 77 |
let _ = Sem.code_gen modularmode in |
61 | 78 |
() |
62 |
) |
|
63 | 79 |
| GenLus -> |
64 |
let module Model = (val model) in |
|
65 |
let state_vars = Datatype.SF.states Model.model in |
|
66 |
let global_vars = |
|
67 |
List.map (fun (v,e) -> {Basetypes.GlobalVarDef.variable = v; init_val = e;}) |
|
68 |
(Datatype.SF.global_vars Model.model) in |
|
69 |
|
|
70 |
let module T = CPS_lustre_generator.LustrePrinter (struct |
|
71 |
let state_vars = state_vars |
|
72 |
let global_vars = global_vars |
|
73 |
end) in |
|
74 |
let module Sem = CPS.Semantics (T) (Model) in |
|
75 |
let prog = Sem.code_gen modularmode in |
|
76 |
Options.print_dec_types := true; |
|
77 |
Format.printf "%a@." Printers.pp_prog prog; |
|
78 |
|
|
79 |
let auto_file = "sf_gen_test_auto.lus" in (* Could be changed *) |
|
80 |
let auto_out = open_out auto_file in |
|
81 |
let auto_fmt = Format.formatter_of_out_channel auto_out in |
|
82 |
Format.fprintf auto_fmt "%a@." Printers.pp_prog prog; |
|
83 |
|
|
84 |
let params = Backends.get_normalization_params () in |
|
85 |
let prog, _ = Compiler_stages.stage1 params prog "" "" ".lus" in |
|
86 |
|
|
87 |
|
|
88 |
Options.print_dec_types := false; |
|
89 |
Format.printf "%a@." Printers.pp_prog prog; |
|
90 |
let noauto_file = "sf_gen_test_noauto.lus" in (* Could be changed *) |
|
91 |
let noauto_out = open_out noauto_file in |
|
92 |
let noauto_fmt = Format.formatter_of_out_channel noauto_out in |
|
93 |
Format.fprintf noauto_fmt "%a@." Printers.pp_prog prog |
|
94 |
|
|
95 |
|
|
96 |
|
|
80 |
let module Model = (val model) in |
|
81 |
let state_vars = Datatype.SF.states Model.model in |
|
82 |
let global_vars = |
|
83 |
List.map |
|
84 |
(fun (v, e) -> { Basetypes.GlobalVarDef.variable = v; init_val = e }) |
|
85 |
(Datatype.SF.global_vars Model.model) |
|
86 |
in |
|
87 |
|
|
88 |
let module T = CPS_lustre_generator.LustrePrinter (struct |
|
89 |
let state_vars = state_vars |
|
90 |
|
|
91 |
let global_vars = global_vars |
|
92 |
end) in |
|
93 |
let module Sem = CPS.Semantics (T) (Model) in |
|
94 |
let prog = Sem.code_gen modularmode in |
|
95 |
Options.print_dec_types := true; |
|
96 |
Format.printf "%a@." Printers.pp_prog prog; |
|
97 |
|
|
98 |
let auto_file = "sf_gen_test_auto.lus" in |
|
99 |
(* Could be changed *) |
|
100 |
let auto_out = open_out auto_file in |
|
101 |
let auto_fmt = Format.formatter_of_out_channel auto_out in |
|
102 |
Format.fprintf auto_fmt "%a@." Printers.pp_prog prog; |
|
103 |
|
|
104 |
let params = Backends.get_normalization_params () in |
|
105 |
let prog, _ = Compiler_stages.stage1 params prog "" "" ".lus" in |
|
106 |
|
|
107 |
Options.print_dec_types := false; |
|
108 |
Format.printf "%a@." Printers.pp_prog prog; |
|
109 |
let noauto_file = "sf_gen_test_noauto.lus" in |
|
110 |
(* Could be changed *) |
|
111 |
let noauto_out = open_out noauto_file in |
|
112 |
let noauto_fmt = Format.formatter_of_out_channel noauto_out in |
|
113 |
Format.fprintf noauto_fmt "%a@." Printers.pp_prog prog |
|
114 |
|
|
97 | 115 |
(* Local Variables: *) |
98 | 116 |
(* compile-command: "make -C ../.. lustresf" *) |
99 | 117 |
(* End: *) |
Also available in: Unified diff
reformatting