Project

General

Profile

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