1 |
a2d97a3e
|
ploc
|
(********************************************************************)
|
2 |
|
|
(* *)
|
3 |
|
|
(* The LustreC compiler toolset / The LustreC Development Team *)
|
4 |
|
|
(* Copyright 2012 - -- ONERA - CNRS - INPT *)
|
5 |
|
|
(* *)
|
6 |
|
|
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *)
|
7 |
|
|
(* under the terms of the GNU Lesser General Public License *)
|
8 |
|
|
(* version 2.1. *)
|
9 |
|
|
(* *)
|
10 |
|
|
(********************************************************************)
|
11 |
|
|
|
12 |
cf78a589
|
ploc
|
open Corelang
|
13 |
01c7d5e1
|
ploc
|
open LustreSpec
|
14 |
cf78a589
|
ploc
|
|
15 |
|
|
(* Consts unfoooolding *)
|
16 |
|
|
let is_const i consts =
|
17 |
|
|
List.exists (fun c -> c.const_id = i) consts
|
18 |
|
|
|
19 |
|
|
let get_const i consts =
|
20 |
|
|
let c = List.find (fun c -> c.const_id = i) consts in
|
21 |
|
|
c.const_value
|
22 |
|
|
|
23 |
|
|
let rec expr_unfold_consts consts e =
|
24 |
429ab729
|
ploc
|
{ e with expr_desc = expr_desc_unfold_consts consts e.expr_desc e.expr_type }
|
25 |
cf78a589
|
ploc
|
|
26 |
429ab729
|
ploc
|
and expr_desc_unfold_consts consts e e_type =
|
27 |
cf78a589
|
ploc
|
let unfold = expr_unfold_consts consts in
|
28 |
|
|
match e with
|
29 |
|
|
| Expr_const _ -> e
|
30 |
429ab729
|
ploc
|
| Expr_ident i -> if is_const i consts && not (Types.is_array_type e_type) then Expr_const (get_const i consts) else e
|
31 |
cf78a589
|
ploc
|
| Expr_array el -> Expr_array (List.map unfold el)
|
32 |
|
|
| Expr_access (e1, d) -> Expr_access (unfold e1, d)
|
33 |
|
|
| Expr_power (e1, d) -> Expr_power (unfold e1, d)
|
34 |
|
|
| Expr_tuple el -> Expr_tuple (List.map unfold el)
|
35 |
|
|
| Expr_ite (c, t, e) -> Expr_ite (unfold c, unfold t, unfold e)
|
36 |
|
|
| Expr_arrow (e1, e2)-> Expr_arrow (unfold e1, unfold e2)
|
37 |
|
|
| Expr_fby (e1, e2) -> Expr_fby (unfold e1, unfold e2)
|
38 |
|
|
(* | Expr_concat (e1, e2) -> Expr_concat (unfold e1, unfold e2) *)
|
39 |
|
|
(* | Expr_tail e' -> Expr_tail (unfold e') *)
|
40 |
|
|
| Expr_pre e' -> Expr_pre (unfold e')
|
41 |
|
|
| Expr_when (e', i, l)-> Expr_when (unfold e', i, l)
|
42 |
|
|
| Expr_merge (i, hl) -> Expr_merge (i, List.map (fun (t, h) -> (t, unfold h)) hl)
|
43 |
01c7d5e1
|
ploc
|
| Expr_appl (i, e', i') -> Expr_appl (i, unfold e', i')
|
44 |
cf78a589
|
ploc
|
|
45 |
|
|
let eq_unfold_consts consts eq =
|
46 |
|
|
{ eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }
|
47 |
|
|
|
48 |
|
|
let node_unfold_consts consts node =
|
49 |
b08ffca7
|
xthirioux
|
{ node with node_stmts = List.map (fun eq -> Eq (eq_unfold_consts consts eq)) (get_node_eqs node) }
|
50 |
cf78a589
|
ploc
|
|
51 |
|
|
let prog_unfold_consts prog =
|
52 |
ef34b4ae
|
xthirioux
|
let consts = List.map const_of_top (get_consts prog) in
|
53 |
cf78a589
|
ploc
|
List.map (
|
54 |
|
|
fun decl -> match decl.top_decl_desc with
|
55 |
|
|
| Node nd -> {decl with top_decl_desc = Node (node_unfold_consts consts nd)}
|
56 |
|
|
| _ -> decl
|
57 |
|
|
) prog
|
58 |
|
|
|
59 |
d0b1ec56
|
xthirioux
|
(* Distribution of when inside sub-expressions, i.e. (a+b) when c --> a when c + b when c
|
60 |
|
|
May increase clock disjointness of variables, which is useful for code optimization
|
61 |
|
|
*)
|
62 |
add75bcb
|
xthirioux
|
let apply_stack expr stack =
|
63 |
|
|
List.fold_left (fun expr (v, t) -> mkexpr expr.expr_loc (Expr_when (expr, v, t))) expr stack
|
64 |
|
|
|
65 |
|
|
let expr_distribute_when expr =
|
66 |
|
|
let rec distrib stack expr =
|
67 |
|
|
match expr.expr_desc with
|
68 |
|
|
| Expr_const _
|
69 |
|
|
| Expr_ident _
|
70 |
|
|
| Expr_arrow _
|
71 |
|
|
| Expr_fby _
|
72 |
|
|
| Expr_pre _
|
73 |
|
|
-> apply_stack expr stack
|
74 |
|
|
| Expr_appl (id, _, _) when not (Stateless.check_node (node_from_name id))
|
75 |
|
|
-> apply_stack expr stack
|
76 |
|
|
| Expr_ite (c, t, e)
|
77 |
|
|
-> let cid = ident_of_expr c in
|
78 |
|
|
mkexpr expr.expr_loc
|
79 |
|
|
(Expr_merge (cid,
|
80 |
|
|
[(tag_true , distrib ((cid,tag_true )::stack) t);
|
81 |
|
|
(tag_false, distrib ((cid,tag_false)::stack) e)]))
|
82 |
|
|
| Expr_array el -> { expr with expr_desc = (Expr_array (List.map (distrib stack) el)) }
|
83 |
|
|
| Expr_access (e1, d) -> { expr with expr_desc = Expr_access (distrib stack e1, d) }
|
84 |
|
|
| Expr_power (e1, d) -> { expr with expr_desc = Expr_power (distrib stack e1, d) }
|
85 |
|
|
| Expr_tuple el -> { expr with expr_desc = Expr_tuple (List.map (distrib stack) el) }
|
86 |
|
|
| Expr_when (e', i, l)-> distrib ((i, l)::stack) e'
|
87 |
|
|
| Expr_merge (i, hl) -> { expr with expr_desc = Expr_merge (i, List.map (fun (t, h) -> (t, distrib stack h)) hl) }
|
88 |
|
|
| Expr_appl (id, e', i') -> { expr with expr_desc = Expr_appl (id, distrib stack e', i')}
|
89 |
|
|
in distrib [] expr
|
90 |
|
|
|
91 |
|
|
let eq_distribute_when eq =
|
92 |
|
|
{ eq with eq_rhs = expr_distribute_when eq.eq_rhs }
|
93 |
|
|
|
94 |
|
|
let node_distribute_when node =
|
95 |
b08ffca7
|
xthirioux
|
{ node with node_stmts = List.map (fun eq -> Eq (eq_distribute_when eq)) (get_node_eqs node) }
|
96 |
add75bcb
|
xthirioux
|
|
97 |
|
|
let prog_distribute_when prog =
|
98 |
|
|
List.map (
|
99 |
|
|
fun decl -> match decl.top_decl_desc with
|
100 |
|
|
| Node nd -> {decl with top_decl_desc = Node (node_distribute_when nd)}
|
101 |
|
|
| _ -> decl
|
102 |
|
|
) prog
|
103 |
cf78a589
|
ploc
|
(* Local Variables: *)
|
104 |
|
|
(* compile-command:"make -C .." *)
|
105 |
|
|
(* End: *)
|