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 Dimension

14

open Utils

15

open ISet

16

module Live = Map.Make (Int)

17


18

let assigned s eq = union s (of_list eq.eq_lhs)

19


20

let rec occur_dim_expr s d =

21

match d.dim_desc with

22

 Dident x >

23

add x s

24

 Dappl (_, ds) >

25

List.fold_left occur_dim_expr s ds

26

 Dite (e, t, f) >

27

occur_dim_expr (occur_dim_expr (occur_dim_expr s e) t) f

28

 Dlink d >

29

occur_dim_expr s d

30

 _ >

31

s

32


33

let rec occur_expr s e =

34

match e.expr_desc with

35

 Expr_ident x >

36

add x s

37

 Expr_tuple es  Expr_array es >

38

List.fold_left occur_expr s es

39

 Expr_ite (e, t, f) >

40

occur_expr (occur_expr (occur_expr s e) t) f

41

 Expr_arrow (e1, e2)  Expr_fby (e1, e2) >

42

occur_expr (occur_expr s e1) e2

43

 Expr_access (e, d)  Expr_power (e, d) >

44

occur_expr (occur_dim_expr s d) e

45

 Expr_pre e >

46

occur_expr s e

47

 Expr_when (e, x, _) >

48

occur_expr (add x s) e

49

 Expr_merge (x, les) >

50

List.fold_left (fun s (_, e) > occur_expr s e) (add x s) les

51

 Expr_appl (_, e, r) >

52

occur_expr (match r with Some r > occur_expr s r  None > s) e

53

 _ >

54

s

55


56

let occur s eq = occur_expr s eq.eq_rhs

57


58

let live : (ident, ISet.t Live.t) Hashtbl.t = Hashtbl.create 32

59


60

let of_var_decls = List.fold_left (fun s v > add v.var_id s) empty

61


62

let set_live_of nid outputs locals sorted_eqs =

63

let outputs = of_var_decls outputs in

64

let locals = of_var_decls locals in

65

let vars = union locals outputs in

66

let no_occur_after i =

67

let occ, _ =

68

List.fold_left

69

(fun (s, j) eq > if j <= i then s, j + 1 else occur s eq, j + 1)

70

(empty, 0) sorted_eqs

71

in

72

diff locals occ

73

in

74

let l, _, _ =

75

List.fold_left

76

(fun (l, asg, i) eq >

77

let asg = inter (assigned asg eq) vars in

78

let noc = no_occur_after i in

79

let liv = diff asg noc in

80

Live.add (i + 1) liv l, asg, i + 1)

81

(Live.add 0 empty Live.empty, empty, 0)

82

sorted_eqs

83

in

84

Log.report ~level:6 (fun fmt >

85

Format.(

86

fprintf fmt "Live variables of %s: %a@;@;" nid

87

(pp_print_list ~pp_open_box:pp_open_vbox0 (fun fmt (i, l) >

88

fprintf fmt "%i: %a" i pp_iset l))

89

(Live.bindings l)));

90

Hashtbl.add live nid l

91


92

let live_i nid i = Live.find i (Hashtbl.find live nid)

93


94

let inter_live_i_with nid i =

95

let li = live_i nid i in

96

List.filter (fun v > mem v.var_id li)

97


98

let existential_vars nid i eq =

99

let li' = live_i nid (i  1) in

100

let li = live_i nid i in

101

let d = diff (union li' (assigned empty eq)) li in

102

List.filter (fun v > mem v.var_id d)
