lustrec / src / splitting.ml @ 0cbf0839
History | View | Annotate | Download (3.69 KB)
1 | 0cbf0839 | ploc | (* ---------------------------------------------------------------------------- |
---|---|---|---|
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: *) |