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 =

19

Live.bindings

20


21

let assigned s eq =

22

union s (of_list eq.eq_lhs)

23


24

let rec occur_dim_expr s d =

25

match d.dim_desc with

26

 Dident x >

27

add x s

28

 Dappl (_, ds) >

29

List.fold_left occur_dim_expr s ds

30

 Dite (e, t, f) >

31

occur_dim_expr (occur_dim_expr (occur_dim_expr s e) t) f

32

 Dlink d >

33

occur_dim_expr s d

34

 _ > s

35


36

let rec occur_expr s e =

37

match e.expr_desc with

38

 Expr_ident x >

39

add x s

40

 Expr_tuple es

41

 Expr_array es >

42

List.fold_left occur_expr s es

43

 Expr_ite (e, t, f) >

44

occur_expr (occur_expr (occur_expr s e) t) f

45

 Expr_arrow (e1, e2)

46

 Expr_fby (e1, e2) >

47

occur_expr (occur_expr s e1) e2

48

 Expr_access (e, d)

49

 Expr_power (e, d) >

50

occur_expr (occur_dim_expr s d) e

51

 Expr_pre e >

52

occur_expr s e

53

 Expr_when (e, x, _) >

54

occur_expr (add x s) e

55

 Expr_merge (x, les) >

56

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

57

 Expr_appl (_, e, r) >

58

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

59

 _ > s

60


61

let occur s eq =

62

occur_expr s eq.eq_rhs

63


64

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

65


66

let of_var_decls =

67

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

68


69

let set_live_of nid outputs locals sorted_eqs =

70

let outputs = of_var_decls outputs in

71

let locals = of_var_decls locals in

72

let vars = union locals outputs in

73

let no_occur_after i =

74

let occ, _ = List.fold_left (fun (s, j) eq >

75

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

76

(empty, 0) sorted_eqs in

77

diff locals occ

78

in

79

let l, _, _ = List.fold_left (fun (l, asg, i) eq >

80

let asg = inter (assigned asg eq) vars in

81

let noc = no_occur_after i in

82

let liv = diff asg noc in

83

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

84

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

85

Log.report ~level:6 (fun fmt >

86

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

87

(pp_print_list ~pp_open_box:pp_open_vbox0

88

(fun fmt (i, l) > 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 =

93

Live.find i (Hashtbl.find live nid)

94


95

let inter_live_i_with nid i =

96

let li = live_i nid i in

97

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

98


99

let existential_vars nid i eq =

100

let li' = live_i nid (i1) in

101

let li = live_i nid i in

102

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

103

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