## lustrec/src/optimize_prog.ml @ 9d3bcc89

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 | e47138b8 | ploc | open Lustre_types |

13 | cf78a589 | ploc | open Corelang |

14 | e47138b8 | ploc | ```
(* open LustreSpec *)
``` |

15 | cf78a589 | ploc | |

16 | ```
(* Consts unfoooolding *)
``` |
||

17 | let is_const i consts = |
||

18 | List.exists (fun c -> c.const_id = i) consts |
||

19 | |||

20 | let get_const i consts = |
||

21 | let c = List.find (fun c -> c.const_id = i) consts in |
||

22 | c.const_value |
||

23 | |||

24 | let rec expr_unfold_consts consts e = |
||

25 | 429ab729 | ploc | { e with expr_desc = expr_desc_unfold_consts consts e.expr_desc e.expr_type } |

26 | cf78a589 | ploc | |

27 | 429ab729 | ploc | and expr_desc_unfold_consts consts e e_type = |

28 | cf78a589 | ploc | let unfold = expr_unfold_consts consts in |

29 | match e with |
||

30 | | Expr_const _ -> e |
||

31 | 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 |

32 | cf78a589 | ploc | | Expr_array el -> Expr_array (List.map unfold el) |

33 | | Expr_access (e1, d) -> Expr_access (unfold e1, d) |
||

34 | | Expr_power (e1, d) -> Expr_power (unfold e1, d) |
||

35 | | Expr_tuple el -> Expr_tuple (List.map unfold el) |
||

36 | | Expr_ite (c, t, e) -> Expr_ite (unfold c, unfold t, unfold e) |
||

37 | | Expr_arrow (e1, e2)-> Expr_arrow (unfold e1, unfold e2) |
||

38 | | Expr_fby (e1, e2) -> Expr_fby (unfold e1, unfold e2) |
||

39 | ```
(* | Expr_concat (e1, e2) -> Expr_concat (unfold e1, unfold e2) *)
``` |
||

40 | ```
(* | Expr_tail e' -> Expr_tail (unfold e') *)
``` |
||

41 | | Expr_pre e' -> Expr_pre (unfold e') |
||

42 | | Expr_when (e', i, l)-> Expr_when (unfold e', i, l) |
||

43 | | Expr_merge (i, hl) -> Expr_merge (i, List.map (fun (t, h) -> (t, unfold h)) hl) |
||

44 | 01c7d5e1 | ploc | | Expr_appl (i, e', i') -> Expr_appl (i, unfold e', i') |

45 | cf78a589 | ploc | |

46 | let eq_unfold_consts consts eq = |
||

47 | { eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs } |
||

48 | |||

49 | e47138b8 | ploc | let node_unfold_consts consts node = |

50 | let eqs, automata = get_node_eqs node in |
||

51 | assert (automata = []); |
||

52 | { node with node_stmts = List.map (fun eq -> Eq (eq_unfold_consts consts eq)) eqs } |
||

53 | cf78a589 | ploc | |

54 | let prog_unfold_consts prog = |
||

55 | ef34b4ae | xthirioux | let consts = List.map const_of_top (get_consts prog) in |

56 | cf78a589 | ploc | List.map ( |

57 | fun decl -> match decl.top_decl_desc with |
||

58 | | Node nd -> {decl with top_decl_desc = Node (node_unfold_consts consts nd)} |
||

59 | | _ -> decl |
||

60 | ) prog |
||

61 | |||

62 | d0b1ec56 | xthirioux | ```
(* Distribution of when inside sub-expressions, i.e. (a+b) when c --> a when c + b when c
``` |

63 | ```
May increase clock disjointness of variables, which is useful for code optimization
``` |
||

64 | ```
*)
``` |
||

65 | add75bcb | xthirioux | let apply_stack expr stack = |

66 | List.fold_left (fun expr (v, t) -> mkexpr expr.expr_loc (Expr_when (expr, v, t))) expr stack |
||

67 | |||

68 | let expr_distribute_when expr = |
||

69 | let rec distrib stack expr = |
||

70 | match expr.expr_desc with |
||

71 | | Expr_const _ |
||

72 | | Expr_ident _ |
||

73 | | Expr_arrow _ |
||

74 | | Expr_fby _ |
||

75 | | Expr_pre _ |
||

76 | -> apply_stack expr stack |
||

77 | | Expr_appl (id, _, _) when not (Stateless.check_node (node_from_name id)) |
||

78 | -> apply_stack expr stack |
||

79 | | Expr_ite (c, t, e) |
||

80 | -> let cid = ident_of_expr c in |
||

81 | mkexpr expr.expr_loc |
||

82 | (Expr_merge (cid, |
||

83 | [(tag_true , distrib ((cid,tag_true )::stack) t); |
||

84 | (tag_false, distrib ((cid,tag_false)::stack) e)])) |
||

85 | | Expr_array el -> { expr with expr_desc = (Expr_array (List.map (distrib stack) el)) } |
||

86 | | Expr_access (e1, d) -> { expr with expr_desc = Expr_access (distrib stack e1, d) } |
||

87 | | Expr_power (e1, d) -> { expr with expr_desc = Expr_power (distrib stack e1, d) } |
||

88 | | Expr_tuple el -> { expr with expr_desc = Expr_tuple (List.map (distrib stack) el) } |
||

89 | | Expr_when (e', i, l)-> distrib ((i, l)::stack) e' |
||

90 | | Expr_merge (i, hl) -> { expr with expr_desc = Expr_merge (i, List.map (fun (t, h) -> (t, distrib stack h)) hl) } |
||

91 | | Expr_appl (id, e', i') -> { expr with expr_desc = Expr_appl (id, distrib stack e', i')} |
||

92 | in distrib [] expr |
||

93 | |||

94 | let eq_distribute_when eq = |
||

95 | { eq with eq_rhs = expr_distribute_when eq.eq_rhs } |
||

96 | |||

97 | let node_distribute_when node = |
||

98 | e47138b8 | ploc | let eqs, automata = get_node_eqs node in |

99 | assert (automata = []); |
||

100 | { node with node_stmts = List.map (fun eq -> Eq (eq_distribute_when eq)) eqs } |
||

101 | add75bcb | xthirioux | |

102 | let prog_distribute_when prog = |
||

103 | List.map ( |
||

104 | fun decl -> match decl.top_decl_desc with |
||

105 | | Node nd -> {decl with top_decl_desc = Node (node_distribute_when nd)} |
||

106 | | _ -> decl |
||

107 | ) prog |
||

108 | cf78a589 | ploc | ```
(* Local Variables: *)
``` |

109 | ```
(* compile-command:"make -C .." *)
``` |
||

110 | ```
(* End: *)
``` |