From 41faa9b4e54ec502cab8bde6238d6f864fc6676b Mon Sep 17 00:00:00 2001
From: Mamadou Ndiaye <ndiaye@malaval.imag.fr>
Date: Fri, 10 Jul 2015 10:02:56 +0200
Subject: [PATCH] expansion of "boolred" in form of equations.
---
src/compile.ml | 6 ++++++
src/l2lExpandMetaOp.ml | 42 ++++++++++++++++++++++++++++++----------
src/l2lExpandMetaOp.mli | 3 +++
src/licDump.ml | 43 ++++++++++++++++++++++++++++++++++++-----
src/lv6MainArgs.ml | 2 +-
5 files changed, 80 insertions(+), 16 deletions(-)
diff --git a/src/compile.ml b/src/compile.ml
index bb6cde9e..91d74ec5 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 b063b57e..ddd2effc 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 bc0a645c..33164c1a 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 9b818942..e50746be 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 2e752082..432e8db2 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"]
--
GitLab