1

(********************************************************************)

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

open Lustre_types

13

open Corelang

14

(* open LustreSpec *)

15


16

(* Consts unfoooolding *)

17

let is_const i consts = 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

{ e with expr_desc = expr_desc_unfold_consts consts e.expr_desc e.expr_type }

25


26

and expr_desc_unfold_consts consts e e_type =

27

let unfold = expr_unfold_consts consts in

28

match e with

29

 Expr_const _ >

30

e

31

 Expr_ident i >

32

if is_const i consts && not (Types.is_array_type e_type) then

33

Expr_const (get_const i consts)

34

else e

35

 Expr_array el >

36

Expr_array (List.map unfold el)

37

 Expr_access (e1, d) >

38

Expr_access (unfold e1, d)

39

 Expr_power (e1, d) >

40

Expr_power (unfold e1, d)

41

 Expr_tuple el >

42

Expr_tuple (List.map unfold el)

43

 Expr_ite (c, t, e) >

44

Expr_ite (unfold c, unfold t, unfold e)

45

 Expr_arrow (e1, e2) >

46

Expr_arrow (unfold e1, unfold e2)

47

 Expr_fby (e1, e2) >

48

Expr_fby (unfold e1, unfold e2)

49

(*  Expr_concat (e1, e2) > Expr_concat (unfold e1, unfold e2) *)

50

(*  Expr_tail e' > Expr_tail (unfold e') *)

51

 Expr_pre e' >

52

Expr_pre (unfold e')

53

 Expr_when (e', i, l) >

54

Expr_when (unfold e', i, l)

55

 Expr_merge (i, hl) >

56

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

57

 Expr_appl (i, e', i') >

58

Expr_appl (i, unfold e', i')

59


60

let eq_unfold_consts consts eq =

61

{ eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }

62


63

let node_unfold_consts consts node =

64

let eqs, automata = get_node_eqs node in

65

assert (automata = []);

66

{

67

node with

68

node_stmts = List.map (fun eq > Eq (eq_unfold_consts consts eq)) eqs;

69

}

70


71

let prog_unfold_consts prog =

72

let consts = List.map const_of_top (get_consts prog) in

73

List.map

74

(fun decl >

75

match decl.top_decl_desc with

76

 Node nd >

77

{ decl with top_decl_desc = Node (node_unfold_consts consts nd) }

78

 _ >

79

decl)

80

prog

81


82

(* Distribution of when inside subexpressions, i.e. (a+b) when c > a when c +

83

b when c May increase clock disjointness of variables, which is useful for

84

code optimization *)

85

let apply_stack expr stack =

86

List.fold_left

87

(fun expr (v, t) > mkexpr expr.expr_loc (Expr_when (expr, v, t)))

88

expr stack

89


90

let expr_distribute_when expr =

91

let rec distrib stack expr =

92

match expr.expr_desc with

93

 Expr_const _  Expr_ident _  Expr_arrow _  Expr_fby _  Expr_pre _ >

94

apply_stack expr stack

95

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

96

>

97

apply_stack expr stack

98

 Expr_ite (c, t, e) >

99

let cid = ident_of_expr c in

100

mkexpr expr.expr_loc

101

(Expr_merge

102

( cid,

103

[

104

tag_true, distrib ((cid, tag_true) :: stack) t;

105

tag_false, distrib ((cid, tag_false) :: stack) e;

106

] ))

107

 Expr_array el >

108

{ expr with expr_desc = Expr_array (List.map (distrib stack) el) }

109

 Expr_access (e1, d) >

110

{ expr with expr_desc = Expr_access (distrib stack e1, d) }

111

 Expr_power (e1, d) >

112

{ expr with expr_desc = Expr_power (distrib stack e1, d) }

113

 Expr_tuple el >

114

{ expr with expr_desc = Expr_tuple (List.map (distrib stack) el) }

115

 Expr_when (e', i, l) >

116

distrib ((i, l) :: stack) e'

117

 Expr_merge (i, hl) >

118

{

119

expr with

120

expr_desc =

121

Expr_merge (i, List.map (fun (t, h) > t, distrib stack h) hl);

122

}

123

 Expr_appl (id, e', i') >

124

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

125

in

126

distrib [] expr

127


128

let eq_distribute_when eq = { eq with eq_rhs = expr_distribute_when eq.eq_rhs }

129


130

let node_distribute_when node =

131

let eqs, automata = get_node_eqs node in

132

assert (automata = []);

133

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

134


135

let prog_distribute_when prog =

136

List.map

137

(fun decl >

138

match decl.top_decl_desc with

139

 Node nd >

140

{ decl with top_decl_desc = Node (node_distribute_when nd) }

141

 _ >

142

decl)

143

prog

144

(* Local Variables: *)

145

(* compilecommand:"make C .." *)

146

(* End: *)
