Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / optimize_prog.ml @ e8250987

History | View | Annotate | Download (4.43 KB)

1 a2d97a3e ploc
(********************************************************************)
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 cf78a589 ploc
open Corelang
13 01c7d5e1 ploc
open LustreSpec
14 cf78a589 ploc
15
(* Consts unfoooolding *)
16
let is_const i consts = 
17
  List.exists (fun c -> c.const_id = i) consts
18
19
let get_const i consts =
20
  let c = List.find (fun c -> c.const_id = i) consts in
21
  c.const_value
22
23
let rec expr_unfold_consts consts e = 
24 429ab729 ploc
{ e with expr_desc = expr_desc_unfold_consts consts e.expr_desc e.expr_type }
25 cf78a589 ploc
26 429ab729 ploc
and expr_desc_unfold_consts consts e e_type =
27 cf78a589 ploc
  let unfold = expr_unfold_consts consts in
28
  match e with
29
  | Expr_const _ -> e
30 429ab729 ploc
  | Expr_ident i -> if is_const i consts && not (Types.is_array_type e_type) then Expr_const (get_const i consts) else e
31 cf78a589 ploc
  | Expr_array el -> Expr_array (List.map unfold el)
32
  | Expr_access (e1, d) -> Expr_access (unfold e1, d)
33
  | Expr_power (e1, d) -> Expr_power (unfold e1, d)
34
  | Expr_tuple el -> Expr_tuple (List.map unfold el)
35
  | Expr_ite (c, t, e) -> Expr_ite (unfold c, unfold t, unfold e)
36
  | Expr_arrow (e1, e2)-> Expr_arrow (unfold e1, unfold e2) 
37
  | Expr_fby (e1, e2) -> Expr_fby (unfold e1, unfold e2)
38
  (* | Expr_concat (e1, e2) -> Expr_concat (unfold e1, unfold e2) *)
39
  (* | Expr_tail e' -> Expr_tail (unfold e') *)
40
  | Expr_pre e' -> Expr_pre (unfold e')
41
  | Expr_when (e', i, l)-> Expr_when (unfold e', i, l)
42
  | Expr_merge (i, hl) -> Expr_merge (i, List.map (fun (t, h) -> (t, unfold h)) hl)
43 01c7d5e1 ploc
  | Expr_appl (i, e', i') -> Expr_appl (i, unfold e', i')  
44 cf78a589 ploc
45
let eq_unfold_consts consts eq =
46
  { eq with eq_rhs = expr_unfold_consts consts eq.eq_rhs }
47
48
let node_unfold_consts consts node = 
49 b08ffca7 xthirioux
  { node with node_stmts = List.map (fun eq -> Eq (eq_unfold_consts consts eq)) (get_node_eqs node) }
50 cf78a589 ploc
51
let prog_unfold_consts prog =
52 ef34b4ae xthirioux
  let consts = List.map const_of_top (get_consts prog) in
53 cf78a589 ploc
    List.map (
54
      fun decl -> match decl.top_decl_desc with 
55
	| Node nd -> {decl with top_decl_desc = Node (node_unfold_consts consts nd)}
56
	| _       -> decl
57
    ) prog 
58
59 d0b1ec56 xthirioux
(* Distribution of when inside sub-expressions, i.e. (a+b) when c --> a when c + b when c 
60
   May increase clock disjointness of variables, which is useful for code optimization
61
*)
62 add75bcb xthirioux
let apply_stack expr stack =
63
 List.fold_left (fun expr (v, t) -> mkexpr expr.expr_loc (Expr_when (expr, v, t))) expr stack
64
65
let expr_distribute_when expr =
66
  let rec distrib stack expr =
67
    match expr.expr_desc with
68
    | Expr_const _
69
    | Expr_ident _
70
    | Expr_arrow _
71
    | Expr_fby _
72
    | Expr_pre _
73
	-> apply_stack expr stack
74
    | Expr_appl (id, _, _) when not (Stateless.check_node (node_from_name id))
75
	-> apply_stack expr stack
76
    | Expr_ite (c, t, e)
77
        -> let cid = ident_of_expr c in
78
           mkexpr expr.expr_loc
79
	     (Expr_merge (cid,
80
			  [(tag_true , distrib ((cid,tag_true )::stack) t);
81
			   (tag_false, distrib ((cid,tag_false)::stack) e)]))
82
    | Expr_array el -> { expr with expr_desc = (Expr_array (List.map (distrib stack) el)) }
83
    | Expr_access (e1, d) -> { expr with expr_desc = Expr_access (distrib stack e1, d) }
84
    | Expr_power (e1, d) -> { expr with expr_desc = Expr_power (distrib stack e1, d) }
85
    | Expr_tuple el -> { expr with expr_desc = Expr_tuple (List.map (distrib stack) el) }
86
    | Expr_when (e', i, l)-> distrib ((i, l)::stack) e'
87
    | Expr_merge (i, hl) -> { expr with expr_desc = Expr_merge (i, List.map (fun (t, h) -> (t, distrib stack h)) hl) }
88
    | Expr_appl (id, e', i') -> { expr with expr_desc = Expr_appl (id, distrib stack e', i')}
89
  in distrib [] expr
90
91
let eq_distribute_when eq =
92
  { eq with eq_rhs = expr_distribute_when eq.eq_rhs }
93
94
let node_distribute_when node =
95 b08ffca7 xthirioux
  { node with node_stmts = List.map (fun eq -> Eq (eq_distribute_when eq)) (get_node_eqs node) }
96 add75bcb xthirioux
97
let prog_distribute_when prog =
98
    List.map (
99
      fun decl -> match decl.top_decl_desc with 
100
	| Node nd -> {decl with top_decl_desc = Node (node_distribute_when nd)}
101
	| _       -> decl
102
    ) prog 
103 cf78a589 ploc
(* Local Variables: *)
104
(* compile-command:"make -C .." *)
105
(* End: *)