expansion of "boolred" in form of equations.

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

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

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

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)

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"]