lustrec / src / splitting.ml @ 22fe1c93
History | View | Annotate | Download (3.69 KB)
1 |
(* ---------------------------------------------------------------------------- |
---|---|
2 |
* SchedMCore - A MultiCore Scheduling Framework |
3 |
* Copyright (C) 2009-2013, ONERA, Toulouse, FRANCE - LIFL, Lille, FRANCE |
4 |
* Copyright (C) 2012-2013, INPT, Toulouse, FRANCE |
5 |
* |
6 |
* This file is part of Prelude |
7 |
* |
8 |
* Prelude is free software; you can redistribute it and/or |
9 |
* modify it under the terms of the GNU Lesser General Public License |
10 |
* as published by the Free Software Foundation ; either version 2 of |
11 |
* the License, or (at your option) any later version. |
12 |
* |
13 |
* Prelude is distributed in the hope that it will be useful, but |
14 |
* WITHOUT ANY WARRANTY ; without even the implied warranty of |
15 |
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
16 |
* Lesser General Public License for more details. |
17 |
* |
18 |
* You should have received a copy of the GNU Lesser General Public |
19 |
* License along with this program ; if not, write to the Free Software |
20 |
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 |
21 |
* USA |
22 |
*---------------------------------------------------------------------------- *) |
23 |
|
24 |
(* This module is used for the lustre to C compiler *) |
25 |
|
26 |
|
27 |
open Utils |
28 |
open Corelang |
29 |
|
30 |
open Format |
31 |
|
32 |
|
33 |
let rec tuple_split_expr expr = |
34 |
match expr.expr_desc with |
35 |
| Expr_const _ |
36 |
| Expr_ident _ -> [expr] |
37 |
| Expr_tuple elist -> elist |
38 |
| Expr_appl (id, args, r) -> |
39 |
if Basic_library.is_internal_fun id |
40 |
then |
41 |
let args_list = List.map tuple_split_expr (expr_list_of_expr args) in |
42 |
List.map |
43 |
(fun arg -> {expr with expr_tag = Utils.new_tag (); expr_desc = Expr_appl (id, expr_of_expr_list args.expr_loc arg, r) }) |
44 |
(transpose_list args_list) |
45 |
else |
46 |
[expr] |
47 |
| Expr_array el -> |
48 |
let args_list = List.map tuple_split_expr el in |
49 |
List.map |
50 |
(fun arg -> {expr with expr_tag = Utils.new_tag (); expr_desc = Expr_array arg }) |
51 |
(transpose_list args_list) |
52 |
| Expr_access (e1, d) -> |
53 |
List.map |
54 |
(fun e1 -> { expr with expr_tag = Utils.new_tag (); expr_desc = Expr_access (e1, d) }) |
55 |
(tuple_split_expr e1) |
56 |
| Expr_power (e1, d) -> |
57 |
List.map |
58 |
(fun e1 -> { expr with expr_tag = Utils.new_tag (); expr_desc = Expr_power (e1, d) }) |
59 |
(tuple_split_expr e1) |
60 |
| Expr_arrow (e1,e2) -> |
61 |
List.map2 |
62 |
(fun e1 e2 -> { expr with expr_tag = Utils.new_tag (); expr_desc = Expr_arrow (e1, e2) }) |
63 |
(tuple_split_expr e1) |
64 |
(tuple_split_expr e2) |
65 |
| Expr_pre e -> |
66 |
List.map |
67 |
(fun e -> { expr with expr_tag = Utils.new_tag (); expr_desc = Expr_pre e }) |
68 |
(tuple_split_expr e) |
69 |
| Expr_fby (v, e) -> |
70 |
List.map |
71 |
(fun e -> { expr with expr_tag = Utils.new_tag (); expr_desc = Expr_fby (v, e) }) |
72 |
(tuple_split_expr e) |
73 |
| Expr_when (e, c, l) -> |
74 |
List.map |
75 |
(fun e -> { expr with expr_tag = Utils.new_tag (); expr_desc = Expr_when (e, c, l) }) |
76 |
(tuple_split_expr e) |
77 |
| Expr_ite (c, t, e) -> |
78 |
List.map2 |
79 |
(fun t e -> { expr with expr_tag = Utils.new_tag (); expr_desc = Expr_ite (c, t, e) }) |
80 |
(tuple_split_expr t) |
81 |
(tuple_split_expr e) |
82 |
| Expr_merge (c,hl) -> |
83 |
let tl, hl = List.split (List.map (fun (t, h) -> (t, tuple_split_expr h)) hl) in |
84 |
List.map |
85 |
(fun hl -> {expr with expr_tag = Utils.new_tag (); expr_desc = Expr_merge (c, List.combine tl hl) }) |
86 |
(transpose_list hl) |
87 |
| Expr_uclock _ |
88 |
| Expr_dclock _ |
89 |
| Expr_phclock _ -> assert false (* Not handled yet *) |
90 |
|
91 |
let rec tuple_split_eq eq = |
92 |
let split_rhs = tuple_split_expr eq.eq_rhs in |
93 |
if List.length split_rhs = 1 |
94 |
then |
95 |
[eq] |
96 |
else |
97 |
List.map2 |
98 |
(fun lhs rhs -> mkeq eq.eq_loc ([lhs], rhs)) |
99 |
eq.eq_lhs |
100 |
split_rhs |
101 |
|
102 |
let tuple_split_eq_list eqs = |
103 |
List.fold_right (fun eq -> (@) (tuple_split_eq eq)) eqs [] |
104 |
|
105 |
|
106 |
(* Local Variables: *) |
107 |
(* compile-command:"make -C .." *) |
108 |
(* End: *) |