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 =

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

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

26


27

and expr_desc_unfold_consts consts e e_type =

28

let unfold = expr_unfold_consts consts in

29

match e with

30

 Expr_const _ > e

31

 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

 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

 Expr_appl (i, e', i') > Expr_appl (i, unfold e', i')

45


46

let eq_unfold_consts consts eq =

47

{ eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }

48


49

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


54

let prog_unfold_consts prog =

55

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

56

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

(* Distribution of when inside subexpressions, 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

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

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


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

(* Local Variables: *)

109

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

110

(* End: *)
