diff --git a/src/compile.ml b/src/compile.ml
index bb6cde9e39056104bcd4cff1299646b73f77043a..91d74ec5a58b01c6b6c4e1737dd5d7afabdf16d4 100644
--- a/src/compile.ml
+++ b/src/compile.ml
@@ -62,6 +62,12 @@ let (doit : Lv6MainArgs.t -> AstV6.pack_or_model list -> Lv6Id.idref option -> L
L2lExpandMetaOp.doit zelic
)
in
+ let zelic =
+ if Lv6MainArgs.global_opt.Lv6MainArgs.kcg && not opt.Lv6MainArgs.inline_iterator then
+ L2lExpandMetaOp.doit_boolred zelic
+ else
+ zelic
+ in
let zelic =
if
Lv6MainArgs.global_opt.Lv6MainArgs.one_op_per_equation
diff --git a/src/l2lExpandMetaOp.ml b/src/l2lExpandMetaOp.ml
index b063b57e85ecf3cc68ba9bc0c183b927858cf08e..ddd2effc4e8cfad2612384e9d76fdb19ecde31c2 100644
--- a/src/l2lExpandMetaOp.ml
+++ b/src/l2lExpandMetaOp.ml
@@ -484,25 +484,26 @@ let rec (create_meta_op_body: local_ctx -> Lic.node_key -> Lic.node_body * var_
| _,_ -> assert false
-let rec (node : local_ctx -> Lic.node_exp -> Lic.node_exp) =
- fun lctx n ->
+let rec (node : local_ctx -> Lic.node_exp -> bool -> Lic.node_exp) =
+ fun lctx n only_boolred ->
let sonk = Lic.string_of_node_key in
Verbose.exe ~flag:dbg (fun () ->
Printf.printf "#DBG: L2lInlineMetaOp %s\n" (sonk n.node_key_eff));
match n.def_eff with
- | MetaOpLic ->
+ | MetaOpLic ->
+ if only_boolred && (fst n.node_key_eff) <> ("Lustre", "boolred") then n else
let nk = n.node_key_eff in
let nbody, nlocs = create_meta_op_body lctx nk in
{ n with
def_eff = BodyLic nbody;
loclist_eff = Some nlocs;
}
- | ExternLic
- | AbstractLic None -> n
- | AbstractLic (Some pn) ->
- { n with def_eff = AbstractLic (Some (node lctx pn)) }
- | BodyLic b -> n
-
+ | ExternLic
+ | AbstractLic None -> n
+ | AbstractLic (Some pn) ->
+ { n with def_eff = AbstractLic (Some (node lctx pn only_boolred)) }
+ | BodyLic b -> n
+
(* exported *)
let (doit : LicPrg.t -> LicPrg.t) =
fun inprg ->
@@ -518,7 +519,28 @@ let (doit : LicPrg.t -> LicPrg.t) =
prg = inprg;
}
in
- let ne = node lctx ne in
+ let ne = node lctx ne false in
+ LicPrg.add_node nk ne outprg
+ in
+ let outprg = LicPrg.fold_nodes do_node inprg outprg in
+ outprg
+(* exported *)
+
+let (doit_boolred : LicPrg.t -> LicPrg.t) =
+ fun inprg ->
+ let outprg = LicPrg.empty in
+ (** types and constants do not change *)
+ let outprg = LicPrg.fold_types LicPrg.add_type inprg outprg in
+ let outprg = LicPrg.fold_consts LicPrg.add_const inprg outprg in
+ (** transform nodes *)
+ let rec (do_node : Lic.node_key -> Lic.node_exp -> LicPrg.t -> LicPrg.t) =
+ fun nk ne outprg ->
+ let lctx = {
+ node = ne;
+ prg = inprg;
+ }
+ in
+ let ne = node lctx ne true in
LicPrg.add_node nk ne outprg
in
let outprg = LicPrg.fold_nodes do_node inprg outprg in
diff --git a/src/l2lExpandMetaOp.mli b/src/l2lExpandMetaOp.mli
index bc0a645c4d7e5ed564d63e67be40c9903838ace4..33164c1a0af92d604fb7d35e8f0a5f3ac412abd9 100644
--- a/src/l2lExpandMetaOp.mli
+++ b/src/l2lExpandMetaOp.mli
@@ -4,3 +4,6 @@
(** Expand Meta operators (red, map, etc.) *)
val doit : LicPrg.t -> LicPrg.t
+
+(** expand only boolred *)
+val doit_boolred : LicPrg.t -> LicPrg.t
diff --git a/src/licDump.ml b/src/licDump.ml
index 9b818942ffc46b6a5cd81bc62267479cc43966e2..e50746bec99838e8e4734f7671ab027f6375ee52 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -263,6 +263,32 @@ and string_of_node_key_rec (no_prefix:bool) (nkey: node_key) =
then Lv6Id.no_pack_string_of_long ik
else Lv6Id.string_of_long ik
| (ik, salst) ->
+ (*if global_opt.kcg then ((* recursive nodes have been unfold *)
+ (*assert (List.mem ik ["map"]);*)
+ (* not yet working :
+ - cas des noeuds itérés prédéfinis
+ - il genere des alias des noeuds que scade ne comprend pas
+ *)
+ let rec get_node sl =
+ match sl with
+ | [] -> assert false
+ | s::sl -> (match s with
+ | NodeStaticArgLic (_,nk) -> nk,sl
+ | ConstStaticArgLic (_, _)
+ | TypeStaticArgLic (_,_) ->
+ let n,sl = get_node sl in
+ n, s::sl
+ )
+ in
+ let nk, salst = get_node salst in
+ let astrings = List.map static_arg2string_kcg salst in
+ let name = sprintf "(%s %s <<%s>>)" (Lv6Id.no_pack_string_of_long ik)
+ (string_of_node_key_rec no_prefix nk) (String.concat "," astrings)
+ in
+ (FreshName.node_key nkey name)
+
+ )
+ else *)
let astrings = List.map static_arg2string_bis salst in
let name = sprintf "%s_%s" (Lv6Id.no_pack_string_of_long ik) (String.concat "_" astrings) in
(FreshName.node_key nkey name)
@@ -281,7 +307,7 @@ and string_of_node_key_def (nkey: node_key) =
| (ik, []) -> dump_long ik
| (ik, salst) ->
let astrings = List.map (string_of_static_arg) salst in
- sprintf "%s<<%s>>" (Lv6Id.string_of_long ik) (String.concat ", " astrings)
+ sprintf "%s<<%s>>" (Lv6Id.no_pack_string_of_long ik) (String.concat ", " astrings)
(* for inventing a name to parametrized nodes *)
and static_arg2string_bis (sa : Lic.static_arg) =
@@ -292,6 +318,14 @@ and static_arg2string_bis (sa : Lic.static_arg) =
| NodeStaticArgLic (id, (long,_)) ->
sprintf "%s" (Lv6Id.no_pack_string_of_long long)
+and static_arg2string_kcg (sa : Lic.static_arg) =
+ match sa with
+ | ConstStaticArgLic (id, ceff) -> sprintf "%s" (string_ident_of_const_eff ceff)
+ | TypeStaticArgLic (id, teff) -> sprintf "%s" (string_of_type_eff teff)
+ (* | NodeStaticArgLic (id, ((long, _sargs), _, _), _) -> *)
+ | NodeStaticArgLic (id, (long,_)) -> assert false (* should not occur *)
+
+
(* for printing recursive node and iterators *)
and static_arg2string (sa : Lic.static_arg) =
match sa with
@@ -465,10 +499,9 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
| WHEN clk, vel -> (tuple vel) ^ (string_of_clock clk)
- | CURRENT Some _,_ -> if global_opt.kcg then
- "merge " ^ tuple_par (List.tl vel) ^ " (true -> " ^(tuple_par (List.tl vel)) ^ ") (false -> pre " ^ (tuple_par (List.tl vel)) ^ ")"
- else "current " ^ tuple_par (if global_opt.ec then List.tl vel else vel)
- | CURRENT None,_ -> (*if global_opt.kcg then else *) "current " ^ tuple_par vel
+ | CURRENT Some _,_ -> (* transform to merge in kcg mode *)
+ "current " ^ tuple_par (if global_opt.ec then List.tl vel else vel)
+ | CURRENT None,_ -> "current " ^ tuple_par vel
| TUPLE,_ -> (tuple vel)
| CONCAT, [ve1; ve2] ->
(string_of_val_exp_eff ve1) ^ " | " ^ (string_of_val_exp_eff ve2)
diff --git a/src/lv6MainArgs.ml b/src/lv6MainArgs.ml
index 2e752082f8fc3fdb8f8be706f80862366b53e969..432e8db2dbf0d1ca2bbfd1a4061e95acfba769fa 100644
--- a/src/lv6MainArgs.ml
+++ b/src/lv6MainArgs.ml
@@ -338,7 +338,7 @@ let mkoptab (opt:t) : unit = (
mkopt opt ~doc_level:Dev
["-kcg"; "--generate-scade-lustre"]
(Arg.Unit (fun _ ->
- opt.expand_arrays <- true; (* XXX remove me ! *)
+ (* opt.expand_arrays <- true; for problem of "#"; XXX remove me ! *)
global_opt.kcg <- true
))
[" Generate lustre code that is compatible with the lustre of scade"]