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 pp_live fmt l = Live.bindings

19


20

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

21


22

let rec occur_dim_expr s d =

23

match d.dim_desc with

24

 Dident x >

25

add x s

26

 Dappl (_, ds) >

27

List.fold_left occur_dim_expr s ds

28

 Dite (e, t, f) >

29

occur_dim_expr (occur_dim_expr (occur_dim_expr s e) t) f

30

 Dlink d >

31

occur_dim_expr s d

32

 _ >

33

s

34


35

let rec occur_expr s e =

36

match e.expr_desc with

37

 Expr_ident x >

38

add x s

39

 Expr_tuple es  Expr_array es >

40

List.fold_left occur_expr s es

41

 Expr_ite (e, t, f) >

42

occur_expr (occur_expr (occur_expr s e) t) f

43

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

44

occur_expr (occur_expr s e1) e2

45

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

46

occur_expr (occur_dim_expr s d) e

47

 Expr_pre e >

48

occur_expr s e

49

 Expr_when (e, x, _) >

50

occur_expr (add x s) e

51

 Expr_merge (x, les) >

52

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

53

 Expr_appl (_, e, r) >

54

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

55

 _ >

56

s

57


58

let occur s eq = occur_expr s eq.eq_rhs

59


60

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

61


62

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

63


64

let set_live_of nid outputs locals sorted_eqs =

65

let outputs = of_var_decls outputs in

66

let locals = of_var_decls locals in

67

let vars = union locals outputs in

68

let no_occur_after i =

69

let occ, _ =

70

List.fold_left

71

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

72

(empty, 0) sorted_eqs

73

in

74

diff locals occ

75

in

76

let l, _, _ =

77

List.fold_left

78

(fun (l, asg, i) eq >

79

let asg = inter (assigned asg eq) vars in

80

let noc = no_occur_after i in

81

let liv = diff asg noc in

82

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

83

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

84

sorted_eqs

85

in

86

Log.report ~level:6 (fun fmt >

87

Format.(

88

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

89

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

90

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

91

(Live.bindings l)));

92

Hashtbl.add live nid l

93


94

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

95


96

let inter_live_i_with nid i =

97

let li = live_i nid i in

98

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

99


100

let existential_vars nid i eq =

101

let li' = live_i nid (i  1) in

102

let li = live_i nid i in

103

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

104

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