Project

General

Profile

Download (3.67 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 occur_carrier s ckr =
34
  let open Clocks in
35
  match (carrier_repr ckr).carrier_desc with
36
  | Carry_const x -> add x s
37
  | _ -> s
38

    
39
let rec occur_clock s ck =
40
  let open Clocks in
41
  match (repr ck).cdesc with
42
  | Carrow (c1, c2) -> occur_clock (occur_clock s c1) c2
43
  | Ctuple cs -> List.fold_left occur_clock s cs
44
  | Con (ck, cr, _)
45
  | Ccarrying (cr, ck) -> occur_clock (occur_carrier s cr) ck
46
  | _ -> s
47

    
48
let rec occur_expr s e =
49
  let s = occur_clock s e.expr_clock in
50
  match e.expr_desc with
51
  | Expr_ident x ->
52
    add x s
53
  | Expr_tuple es | Expr_array es ->
54
    List.fold_left occur_expr s es
55
  | Expr_ite (e, t, f) ->
56
    occur_expr (occur_expr (occur_expr s e) t) f
57
  | Expr_arrow (e1, e2) | Expr_fby (e1, e2) ->
58
    occur_expr (occur_expr s e1) e2
59
  | Expr_access (e, d) | Expr_power (e, d) ->
60
    occur_expr (occur_dim_expr s d) e
61
  | Expr_pre e ->
62
    occur_expr s e
63
  | Expr_when (e, x, _) ->
64
    occur_expr (add x s) e
65
  | Expr_merge (x, les) ->
66
    List.fold_left (fun s (_, e) -> occur_expr s e) (add x s) les
67
  | Expr_appl (_, e, r) ->
68
    occur_expr (match r with Some r -> occur_expr s r | None -> s) e
69
  | _ ->
70
    s
71

    
72
let occur s eq = occur_expr s eq.eq_rhs
73

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

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

    
78
let set_live_of nid outputs locals sorted_eqs =
79
  let outputs = of_var_decls outputs in
80
  let locals = of_var_decls locals in
81
  let vars = union locals outputs in
82
  let no_occur_after i =
83
    let occ, _ =
84
      List.fold_left
85
        (fun (s, j) eq -> if j <= i then s, j + 1 else occur s eq, j + 1)
86
        (empty, 0)
87
        sorted_eqs
88
    in
89
    diff locals occ
90
  in
91
  let l, _, _ =
92
    List.fold_left
93
      (fun (l, asg, i) eq ->
94
        let asg = inter (assigned asg eq) vars in
95
        let noc = no_occur_after i in
96
        let liv = diff asg noc in
97
        Live.add (i + 1) liv l, asg, i + 1)
98
      (Live.add 0 empty Live.empty, empty, 0)
99
      sorted_eqs
100
  in
101
  Log.report ~level:6 (fun fmt ->
102
      Format.(
103
        fprintf
104
          fmt
105
          "Live variables of %s: %a@;@;"
106
          nid
107
          (pp_print_list ~pp_open_box:pp_open_vbox0 (fun fmt (i, l) ->
108
               fprintf fmt "%i: %a" i ISet.pp l))
109
          (Live.bindings l)));
110
  Hashtbl.add live nid l
111

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

    
114
let inter_live_i_with nid i =
115
  let li = live_i nid i in
116
  List.filter (fun v -> mem v.var_id li)
117

    
118
let existential_vars nid i eq =
119
  let li' = live_i nid (i - 1) in
120
  let li = live_i nid i in
121
  let d = diff (union li' (assigned empty eq)) li in
122
  List.filter (fun v -> mem v.var_id d)
(41-41/99)