Newer
Older
(* Time-stamp: <modified the 13/06/2014 (at 15:49) by Erwan Jahier> *)
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
open Data
open Soc
open Soc2cIdent
(* A boring but simple module... *)
let (lustre_binop : Soc.key -> string -> string) =
fun sk op ->
let ctx = get_ctx_name sk in
Printf.sprintf " %s.z = (%s.x %s %s.y);\n" ctx ctx op ctx
let (lustre_unop : Soc.key -> string -> string) =
fun sk op ->
let ctx = get_ctx_name sk in
Printf.sprintf" %s.z = %s %s.x;\n" ctx op ctx
let (lustre_ite : Soc.key -> string) =
fun sk ->
let ctx = get_ctx_name sk in
Printf.sprintf" %s.z = (%s.c)? %s.xt : %s.xe;\n" ctx ctx ctx ctx
let (lustre_impl : Soc.key -> string) =
fun sk ->
let ctx = get_ctx_name sk in
Printf.sprintf" %s.z = (!%s.x || %s.y);\n" ctx ctx ctx
let (lustre_arrow : Soc.key -> string) =
fun sk ->
let ctx = get_ctx_name sk in
let x,y,z = ctx^".x", ctx^".y", ctx^".z" in
Printf.sprintf" %s = (first_step)? %s : %s;\n" z x y
let (lustre_merge : Soc.key -> string) =
fun sk ->
let ctx = get_ctx_name sk in
let (_,tc::tl,_) = sk in
match tc with
| Bool ->
Printf.sprintf" %s.z = (%s.clk) ? %s.x1 : %s.x2 ;\n" ctx ctx ctx ctx
| Enum(en,el) ->
let case_list = List.mapi
(fun i e -> Printf.sprintf " case %s: %s.x%i; break;\n" (id2s e) ctx i) el
in
let cases = String.concat "" case_list in
Printf.sprintf" %s.z =\n switch (%s.clk){\n%s}\n" ctx ctx cases
| Int ->
let case_list = List.mapi
(fun i e -> Printf.sprintf " case %i: %s.z = %s.x%i; break;\n" i ctx ctx i) tl
in
let cases = String.concat "" case_list in
Printf.sprintf" switch (%s.clk){\n%s}\n" ctx cases
| _ -> assert false
let (lustre_hat : Soc.key -> string) =
fun (n,tl,si_opt) ->
let ctx = get_ctx_name (n,tl,si_opt) in
let i,t = match tl with
| [_;Data.Array(t,i)] -> i,t
| _ -> assert false
in
let buff = ref "" in
for j=0 to i-1 do
buff := !buff^(Soc2cUtil.gen_assign t (Printf.sprintf "%s.z[%d]" ctx j)
(Printf.sprintf "%s.x" ctx));
done;
!buff
let (lustre_array: Soc.key -> string) =
fun (n,tl,si_opt) ->
let ctx = get_ctx_name (n,tl,si_opt) in
let t,i = match List.hd (List.rev tl) with
| Data.Array(t,i) -> t,i
| _ -> assert false
in
let buff = ref "" in
for j=0 to i-1 do
buff := !buff^(Soc2cUtil.gen_assign t (Printf.sprintf "%s.z[%d]" ctx j)
(Printf.sprintf "%s.x%d" ctx (j+1)));
done;
!buff
let (lustre_concat: Soc.key -> string) =
fun (n,tl,si_opt) ->
let ctx = get_ctx_name (n,tl,si_opt) in
let t,s1,s2 = match tl with
| [Data.Array(t,s1); Data.Array(_,s2); _] -> t,s1,s2
| _ -> assert false
in
let t1 = Printf.sprintf "%s.x" ctx
and t2 = Printf.sprintf "%s.y" ctx
and t12 = Printf.sprintf "%s.z" ctx in
(Printf.sprintf " memcpy(%s, %s, sizeof(%s));\n" t12 t1 t1)^
(Printf.sprintf " memcpy(%s[%d], %s, sizeof(%s));\n" t12 s1 t2 t2)
(* Both seems to work *)
(* let buff = ref "" in *)
(* for j=0 to s1-1 do *)
(* buff := !buff^(Soc2cUtil.gen_assign t (Printf.sprintf "%s.z[%d]" ctx j) *)
(* (Printf.sprintf "%s.x[%d]" ctx j)); *)
(* done; *)
(* for j=s1 to s1+s2-1 do *)
(* buff := !buff^(Soc2cUtil.gen_assign t (Printf.sprintf "%s.z[%d]" ctx j) *)
(* (Printf.sprintf "%s.y[%d]" ctx (j-s1))); *)
(* done; *)
(* !buff *)
let (lustre_slice: Soc.key -> string) =
fun sk ->
let ctx = get_ctx_name sk in
assert false
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
(* exported *)
let (get: Soc.key -> string) =
fun sk ->
let (n,tl,si_opt) = sk in
match n with
| "Lustre::rplus"
| "Lustre::plus"
| "Lustre::iplus" -> lustre_binop sk "+"
| "Lustre::itimes"
| "Lustre::times"
| "Lustre::rtimes" -> lustre_binop sk "*"
| "Lustre::idiv"
| "Lustre::div"
| "Lustre::rdiv" -> lustre_binop sk "/"
| "Lustre::islash"
| "Lustre::slash"
| "Lustre::rslash" -> lustre_binop sk "/"
| "Lustre::iminus"
| "Lustre::minus"
| "Lustre::rminus" -> lustre_binop sk "-"
| "Lustre::mod" -> lustre_binop sk "%"
| "Lustre::iuminus"
| "Lustre::uminus"
| "Lustre::ruminus"-> lustre_unop sk "-"
| "Lustre::eq" -> lustre_binop sk "=="
| "Lustre::and" -> lustre_binop sk "&&"
| "Lustre::neq" -> lustre_binop sk "<>"
| "Lustre::or" -> lustre_binop sk "||"
| "Lustre::xor" -> lustre_binop sk "^"
| "Lustre::not" -> lustre_unop sk "!"
| "Lustre::real2int" -> lustre_unop sk "(_integer)"
| "Lustre::int2real" -> lustre_unop sk "(_real)"
| "Lustre::lt"
| "Lustre::rlt"
| "Lustre::ilt" -> lustre_binop sk "<"
| "Lustre::gt"
| "Lustre::rgt"
| "Lustre::igt" -> lustre_binop sk ">"
| "Lustre::lte"
| "Lustre::rlte"
| "Lustre::ilte" -> lustre_binop sk "<="
| "Lustre::gte"
| "Lustre::rgte"
| "Lustre::igte" -> lustre_binop sk ">="
| "Lustre::impl" -> lustre_impl sk
| "Lustre::if"
| "Lustre::rif"
| "Lustre::iif" -> lustre_ite sk
| "Lustre::arrow" -> lustre_arrow sk
| "Lustre::merge" -> lustre_merge sk
| "Lustre::hat" -> lustre_hat sk
| "Lustre::array" -> lustre_array sk
| "Lustre::concat" -> lustre_concat sk
| "Lustre::array_slice" -> lustre_slice sk
| "Lustre::current" -> assert false (* o*)
| "Lustre::nor" -> assert false (* ougth to be translated into boolred *)
| "Lustre::diese" -> assert false (* ditto *)
| _ -> assert false