From 9af5091ae35a87355220fe60907b0c3db3a31a1e Mon Sep 17 00:00:00 2001
From: Erwan Jahier <jahier@imag.fr>
Date: Fri, 22 Mar 2013 09:58:51 +0100
Subject: [PATCH] The -exec mode now supports array concatenation.
---
src/lic2soc.ml | 13 ++++++---
src/socExecEvalPredef.ml | 36 ++++++++++++++---------
src/socPredef.ml | 62 +++++++++++++++++++++++-----------------
3 files changed, 67 insertions(+), 44 deletions(-)
diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index b8024c5a..4ad101e3 100644
--- a/src/lic2soc.ml
+++ b/src/lic2soc.ml
@@ -1,4 +1,4 @@
-(** Time-stamp: <modified the 21/03/2013 (at 16:47) by Erwan Jahier> *)
+(** Time-stamp: <modified the 22/03/2013 (at 09:36) by Erwan Jahier> *)
open Lxm
open Lic
@@ -466,10 +466,9 @@ let rec (actions_of_expression_acc: Lxm.t -> Soc.tbl ->
assert false
| CallByPosLic (by_pos_op_flg, val_exp_list) -> (
match by_pos_op_flg.it with
- (* handled via get_leaf *)
| Lic.ARRAY_SLICE _ | Lic.VAR_REF _ | Lic.CONST_REF _
| Lic.ARRAY_ACCES _ | Lic.STRUCT_ACCESS _ | Lic.TUPLE
- -> assert false (* XXX FINISH ME!!! *)
+ -> assert false (* should not occur: handled via get_leaf *)
| Lic.WHEN ck -> (assert false
(* XXX FINISH ME!!! *)
(* (* L'opérateur when n'est pas un composant, il modifie *)
@@ -698,7 +697,13 @@ let f: (LicPrg.t -> Lic.node_key -> Soc.key * Soc.tbl) =
| Undef_soc (sk,lxm,pos_op, types) ->
let soc = SocPredef.soc_interface_of_pos_op lxm pos_op types in
- assert (sk=soc.key);
+ if sk<>soc.key then (
+ print_string ("Soc key mismatch :\n\t" ^
+ (SocUtils.string_of_soc_key sk) ^ "\n<>\n\t" ^
+ (SocUtils.string_of_soc_key soc.key) ^ "\n");
+ flush stdout;
+ assert false
+ );
let acc_comp = SocMap.add soc.key soc acc_comp in
let t = List.hd types in
(* The arrow is translated into a if. So we make sure that the "if"
diff --git a/src/socExecEvalPredef.ml b/src/socExecEvalPredef.ml
index 0bcab4ea..b88571ed 100644
--- a/src/socExecEvalPredef.ml
+++ b/src/socExecEvalPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/03/2013 (at 17:04) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/03/2013 (at 09:58) by Erwan Jahier> *)
open SocExecValue
open Soc
@@ -207,18 +207,27 @@ let lustre_array tl ctx =
let a = Array.of_list l in
{ ctx with s = sadd ctx.s ("z"::ctx.cpath) (A a) }
- let lustre_hat tl ctx =
- let i = match tl with
- | [_;Soc.Array(_,i)] -> i
- | _ -> assert false
- in
- let (vn,vv) =
- match ([get_val "x" ctx]) with
- | [U] -> "z"::ctx.cpath,U
- | [v] -> "z"::ctx.cpath,A(Array.make i v)
- | _ -> assert false
- in
- { ctx with s = sadd ctx.s vn vv }
+let lustre_concat ctx =
+ let (vn,vv) =
+ match ([get_val "x" ctx; get_val "y" ctx]) with
+ | [A a1; A a2] -> "z"::ctx.cpath, A (Array.append a1 a2)
+ | [U;_] | [_;U] -> "z"::ctx.cpath, U
+ | _ -> assert false
+ in
+ { ctx with s = sadd ctx.s vn vv }
+
+let lustre_hat tl ctx =
+ let i = match tl with
+ | [_;Soc.Array(_,i)] -> i
+ | _ -> assert false
+ in
+ let (vn,vv) =
+ match ([get_val "x" ctx]) with
+ | [U] -> "z"::ctx.cpath,U
+ | [v] -> "z"::ctx.cpath,A(Array.make i v)
+ | _ -> assert false
+ in
+ { ctx with s = sadd ctx.s vn vv }
(* That one is different *)
let lustre_xor ctx = assert false
@@ -260,6 +269,7 @@ let (get: Soc.key -> (ctx -> ctx)) =
| "Lustre::hat" -> lustre_hat tl
| "Lustre::array" -> lustre_array tl
+ | "Lustre::concat" -> lustre_concat
| "Lustre::xor" -> lustre_xor
| "Lustre::diese" -> lustre_diese
diff --git a/src/socPredef.ml b/src/socPredef.ml
index 77cc3664..639b2565 100644
--- a/src/socPredef.ml
+++ b/src/socPredef.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 21/03/2013 (at 17:06) by Erwan Jahier> *)
+(* Time-stamp: <modified the 22/03/2013 (at 09:50) by Erwan Jahier> *)
(** Synchronous Object Code for Predefined operators. *)
@@ -134,13 +134,6 @@ let of_soc_key : Soc.key -> Soc.t =
};
];
precedences = ["set", ["get"]];
- (* init = Some { *)
- (* name = "init"; *)
- (* lxm = Lxm.dummy "predef soc"; *)
- (* idx_ins = [] ; (* XXX ??? *) *)
- (* idx_outs = []; *)
- (* impl = None; *)
- (* }; *)
}
| "Lustre::arrow" ->
let prof = sp tl in
@@ -172,16 +165,7 @@ let of_soc_key : Soc.key -> Soc.t =
];
precedences = ["update_first_instant",["step"]];
have_mem = Some (Bool, Some (Const("true",Bool)));
-
- (* init = Some { *)
- (* name = "init"; *)
- (* lxm = Lxm.dummy "predef soc"; *)
- (* idx_ins = [0]; *)
- (* idx_outs = [0]; *)
- (* impl = Some([],[Call([init], Assign, [Const("false",Bool)])]); *)
- (* }; *)
}
-
| "Lustre::fby" ->
assert false
(* replace fby by '->' + 'pre' ?
@@ -358,6 +342,27 @@ let make_array_soc: int -> Soc.var_type -> Soc.t =
have_mem = None;
}
+let make_array_concat_soc: int -> int -> Soc.var_type -> Soc.t =
+ fun s1 s2 t ->
+ let iprof = (["x", Array(t,s1); "y", Array(t,s2)], ["z", Array(t,s1+s2)])in
+ let key_prof = [Array(t,s1); Array(t,s2); Array(t,s1+s2)] in
+ {
+ key = ("Lustre::concat", key_prof, None);
+ profile = iprof;
+ instances = [];
+ step = [
+ {
+ name = "step";
+ lxm = Lxm.dummy "predef array concat soc";
+ idx_ins = [0;1];
+ idx_outs = [0];
+ impl = None;
+ };
+ ];
+ precedences = [];
+ have_mem = None;
+ }
+
let make_hat_soc: int -> Soc.var_type -> Soc.t =
fun i t ->
@@ -483,30 +488,33 @@ let (soc_interface_of_pos_op:
| Lic.FBY, _ ->
let concrete_type = List.nth types 0 in
let soc = of_soc_key (("Lustre::fby"), types@[concrete_type], None) in
- instanciate_soc soc concrete_type
+ instanciate_soc soc concrete_type
| Lic.PRE, _ ->
let concrete_type = List.nth types 0 in
let soc = of_soc_key (("Lustre::pre"), types@[concrete_type], None) in
- instanciate_soc soc concrete_type
+ instanciate_soc soc concrete_type
| Lic.CURRENT, _ ->
let concrete_type = List.nth types 0 in
let soc = of_soc_key (("Lustre::current"), types@[concrete_type], None) in
- instanciate_soc soc concrete_type
+ instanciate_soc soc concrete_type
| Lic.ARROW, _ ->
let concrete_type = List.nth types 0 in
let soc = of_soc_key (("Lustre::arrow"), types@[concrete_type], None) in
let soc = instanciate_soc soc concrete_type in
soc
| Lic.HAT i,_ ->
- let elt_type = List.nth types 0 in
- (make_hat_soc i elt_type)
+ let elt_type = List.nth types 0 in
+ (make_hat_soc i elt_type)
| Lic.ARRAY, _ ->
- let elt_type = List.nth types 0 in
- let i = (List.length types) in
- (make_array_soc i elt_type)
-
- | Lic.CONCAT ,_-> finish_me lxm ; assert false
+ let elt_type = List.nth types 0 in
+ let i = (List.length types) in
+ (make_array_soc i elt_type)
+
+ | Lic.CONCAT , [Array (t1, s1); Array (t2, s2)]->
+ assert (t1=t2);
+ (make_array_concat_soc s1 s2 t1)
+ | Lic.CONCAT , _ -> assert false
| Lic.CALL _,_ -> assert false (* XXX todo *)
--
GitLab