Project

General

Profile

Download (3.3 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
      Format.printf "asg %i: %a@." (i+1) pp_iset asg;
84
      Format.printf "noc %i: %a@." (i+1) pp_iset noc;
85
      Format.printf "liv %i: %a@." (i+1) pp_iset liv;
86
      Live.add (i + 1) liv l, asg, i + 1)
87
      (Live.add 0 empty Live.empty, empty, 0) sorted_eqs in
88
  Format.(printf "@;%a@." (pp_print_list ~pp_open_box:pp_open_vbox0
89
                           (fun fmt (i, l) -> fprintf fmt "%i : %a" i pp_iset l))
90
                           (Live.bindings l));
91
  Hashtbl.add live nid l
92

    
93
let live_i nid i =
94
  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)