Project

General

Profile

Download (3.23 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 = 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)
(27-27/66)