diff --git a/src/lic2soc.ml b/src/lic2soc.ml
index b8024c5a541e673ef75a383aee56852b953ebbbe..4ad101e30499a32b8b7ea9ded5bf93d9de09f4b7 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 0bcab4ea62e07d5faeb4638cb11bc0c8c77489aa..b88571ed18c586de2502aba004a509e938dc03a2 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 77cc3664e2af8a256023e93bc746ae2d18d59e7e..639b25657b13d62761e8ab0e4973780f973c2121 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 *)