Project

General

Profile

Download (3.21 KB) Statistics
| Branch: | Tag: | Revision:
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 (i-1) 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)
(27-27/66)