diff --git a/src/licDump.ml b/src/licDump.ml
index 7e0dcc0ea40e49b0047155e8c8f598ffdd543cf0..8efdfd4d3faa17576652ae3870f38fdedacc2ac7 100644
--- a/src/licDump.ml
+++ b/src/licDump.ml
@@ -9,10 +9,15 @@ open Lv6MainArgs
(* XXX changer le nom de cette fonction *)
let (dump_long : Lv6Id.long -> string) = fun x ->
- if global_opt.no_prefix then
- Lv6Id.no_pack_string_of_long x
- else
- Lv6Id.string_of_long x
+ if global_opt.kcg then
+ Lv6Id.no_pack_string_of_long x
+ else
+ if global_opt.no_prefix then
+ Lv6Id.no_pack_string_of_long x
+ else
+ Lv6Id.string_of_long x
+
+
(* fun id -> *)
(* let str = Lv6Id.string_of_long id in *)
(* Str.global_replace (Str.regexp "::") "__" str *)
@@ -47,6 +52,7 @@ let string_of_ident x =
else Lv6Id.string_of_long2 x
+
let rec string_of_const_eff =
function
| Bool_const_eff true -> "true"
@@ -151,6 +157,9 @@ and string_def_of_type_eff = function
None -> ""
| Some ce -> " = " ^ (string_of_const_eff ce)
in
+ if global_opt.kcg then
+ (List.fold_left (f ", ") (f "" " {" (List.hd fl)) (List.tl fl)) ^ "}"
+ else
"struct " ^
(List.fold_left (f "; ") (f "" " {" (List.hd fl)) (List.tl fl)) ^ "}"
@@ -170,11 +179,11 @@ and string_of_type_eff = function
| Enum_type_eff (name, _) ->
(match global_opt.Lv6MainArgs.expand_enums with
| AsEnum | AsConst -> string_of_ident name
- | AsInt -> "int"
+ | AsInt ->if global_opt.kcg then dump_long name else "int"
)
| Array_type_eff (ty, sz) ->
Printf.sprintf "%s^%d" (string_of_type_eff ty) sz
- | Struct_type_eff (name, _) -> (string_of_ident name)
+ | Struct_type_eff (name, _) -> (if global_opt.kcg then dump_long name else string_of_ident name)
| TypeVar Any -> "any"
| (TypeVar AnyNum) -> "anynum"
@@ -407,19 +416,37 @@ and (string_of_by_pos_op_eff: Lic.by_pos_op srcflagged -> Lic.val_exp list -> st
| CONST_REF idl, _ -> dump_long idl
| VAR_REF id, _ -> id
| PRE, _ -> "pre " ^ (tuple_par vel)
- | ARROW, [ve1; ve2] ->
+ | ARROW, [ve1; ve2] -> (* if global_opt.kcg then (
+ "fby(" ^
+ (if is_a_tuple ve2 then tuple_par [ve2] else string_of_val_exp_eff ve2)
+ ^ ";1;" ^
+ (if is_a_tuple ve2 then tuple_par [ve1] else string_of_val_exp_eff ve1) ^ ")"
+
+ )
+ else( *)
(if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1) ^
" -> " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
+
| FBY, [ve1; ve2] ->
+ (* dead code ? *)
if global_opt.lv4 then
(if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1)
^ " -> pre " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
else
+ if global_opt.kcg then (
+ "fby(" ^
+ (if is_a_tuple ve2 then tuple_par [ve2] else string_of_val_exp_eff ve2)
+ ^ ";1;" ^
+ (if is_a_tuple ve2 then tuple_par [ve1] else string_of_val_exp_eff ve1) ^ ")"
+
+ )
+ else(
(if is_a_tuple ve1 then tuple_par [ve1] else string_of_val_exp_eff ve1)
^ " fby " ^
(if is_a_tuple ve1 then tuple_par [ve2] else string_of_val_exp_eff ve2)
+ )
| WHEN clk, vel -> (tuple vel) ^ (string_of_clock clk)
| CURRENT Some _,_ -> "current " ^ tuple_par (if global_opt.ec then List.tl vel else vel)
@@ -485,10 +512,16 @@ and string_of_val_exp_eff_core ve_core =
"if " ^ (string_of_val_exp_eff ve) ^ " then current (" ^
(string_of_val_exp_eff ct) ^ ") else current (" ^
(string_of_val_exp_eff cf) ^")"
+ ) else (
+ if global_opt.kcg then (
+ "merge ( " ^ (string_of_val_exp_eff ve) ^ ";" ^
+ (string_of_val_exp_eff ct) ^ "when " ^(string_of_val_exp_eff ve) ^ ";" ^
+ (string_of_val_exp_eff cf) ^ "when not " ^ (string_of_val_exp_eff ve) ^ ")"
) else (
"merge " ^ (string_of_val_exp_eff ve) ^ " (true -> " ^
(string_of_val_exp_eff ct) ^ ") (false -> "^ (string_of_val_exp_eff cf) ^")"
)
+ )
| Merge (ve, cl) -> (
"merge " ^ (string_of_val_exp_eff ve) ^ " " ^
(String.concat " "
@@ -554,6 +587,7 @@ and (string_of_eq : Lic.eq_info srcflagged -> string) =
and wrap_long_profile str =
+
if String.length str < 75 then str else
"\n"^(
Str.global_replace (Str.regexp "returns") "\nreturns"
@@ -562,8 +596,10 @@ and wrap_long_profile str =
and (profile_of_node_exp_eff: Lic.node_exp -> string) =
fun neff ->
- ("(" ^ (string_of_type_decl_list neff.inlist_eff "; ") ^ ") returns (" ^
- (string_of_type_decl_list neff.outlist_eff "; ") ^ ")")
+
+ ("(" ^ (string_of_type_decl_list neff.inlist_eff "; ") ^ ") returns (" ^
+ (string_of_type_decl_list neff.outlist_eff "; ") ^ ")")
+
and (string_of_node_def : Lic.node_def -> string list) =
function
@@ -588,7 +624,7 @@ and (type_decl: Lv6Id.long -> Lic.type_ -> string) =
| Abstract_type_eff(_,External_type_eff (_)) -> ";\n"
| _ -> " = " ^ (string_def_of_type_eff teff) ^ ";\n"
)
-
+
(* exported *)
and (const_decl: Lv6Id.long -> Lic.const -> string) =
fun tname ceff ->
@@ -605,7 +641,8 @@ and (const_decl: Lv6Id.long -> Lic.const -> string) =
| Array_const_eff _
| Bool_const_eff _
| Int_const_eff _
- | Real_const_eff _ -> begin_str ^ " = " ^ end_str
+ | Real_const_eff _ -> if global_opt.kcg then begin_str ^ ":" ^ (string_of_type_eff (Lic.type_of_const ceff)) ^ " = " ^ end_str
+ else begin_str ^ " = " ^ end_str
| Tuple_const_eff _ ->
print_internal_error "LicDump.const_decl" "should not have been called for a tuple";
assert false
@@ -622,18 +659,22 @@ and node_of_node_exp_eff (neff: Lic.node_exp): string =
(* no extern kwd in v4... *)
then "extern " else ""
)^(
- if global_opt.lv4 then (
- (* node and function does not have the same meaning in v4... *)
+ if global_opt.lv4 || global_opt.kcg then (
+ (* node and function does not have the same meaning in scade and in lv4... *)
if neff.def_eff = ExternLic then "function " else "node "
) else (
if neff.has_mem_eff then "node " else "function "
)
- )^(
- string_of_node_key_rec global_opt.no_prefix neff.node_key_eff
+ )^(
+ if global_opt.kcg then
+ string_of_node_key_rec (not global_opt.no_prefix) neff.node_key_eff
+ else
+ string_of_node_key_rec global_opt.no_prefix neff.node_key_eff
)^(
profile_of_node_exp_eff neff
- )
- )^(
+ )
+ )^
+ (
match neff.def_eff with
| ExternLic -> ";\n"
| MetaOpLic -> (
@@ -644,22 +685,19 @@ and node_of_node_exp_eff (neff: Lic.node_exp): string =
)
| AbstractLic _ -> ";\n"
| BodyLic _ -> (
- ";\n"^
- (
- match neff.loclist_eff with
- | None -> ""
- | Some [] -> ""
- | Some l ->
- "var\n " ^ (string_of_type_decl_list l ";\n ") ^ ";\n"
- ) ^
- "let\n " ^
- (String.concat "\n " (string_of_node_def neff.def_eff)) ^
- "\ntel\n-- end of node " ^
- (string_of_node_key_rec global_opt.no_prefix neff.node_key_eff) ^ "\n"
- )
+ (if global_opt.kcg then "\n" else ";\n") ^
+ (match neff.loclist_eff with
+ | None -> ""
+ | Some [] -> ""
+ | Some l ->
+ ("var\n " ^ (string_of_type_decl_list l ";\n ") ^ ";\n"
+ ) ^
+ "let\n " ^
+ (String.concat "\n " (string_of_node_def neff.def_eff)) ^
+ "\ntel\n-- end of node " ^
+ (string_of_node_key_rec (not global_opt.no_prefix) neff.node_key_eff) ^ "\n")
+ )
)
-
-
and (string_of_clock_exp : AstCore.clock_exp -> string) =
function
| AstCore.Base -> ""
diff --git a/src/licPrg.ml b/src/licPrg.ml
index 612ead3765f4e238ad27cbb88966012531f336d0..c7f0fb8f00c42412051d49649fafc2a774d417cd 100644
--- a/src/licPrg.ml
+++ b/src/licPrg.ml
@@ -1,4 +1,5 @@
(* Time-stamp: <modified the 03/03/2015 (at 10:42) by Erwan Jahier> *)
+open Lv6MainArgs
module ItemKeyMap = struct
include Map.Make (
@@ -120,10 +121,16 @@ let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Lv6Id.idref option) =
(* On imprime dans l'ordre du iter, donc pas terrible ???
*)
ItemKeyMap.iter
- (fun tn te ->
- if ((not Lv6MainArgs.global_opt.Lv6MainArgs.lv4 || Lic.is_extern_type te)
- && (Lv6MainArgs.global_opt.Lv6MainArgs.expand_enums = Lv6MainArgs.AsEnum))
- then
+ (fun tn te ->
+ if global_opt.kcg then
+ if ((not Lv6MainArgs.global_opt.Lv6MainArgs.lv4 || Lic.is_extern_type te)
+ (* && (Lv6MainArgs.global_opt.Lv6MainArgs.expand_enums = Lv6MainArgs.AsEnum)*))
+ then
+ output_string opt.Lv6MainArgs.oc (LicDump.type_decl tn te)
+ else
+ if ((not Lv6MainArgs.global_opt.Lv6MainArgs.lv4 || Lic.is_extern_type te)
+ && (Lv6MainArgs.global_opt.Lv6MainArgs.expand_enums = Lv6MainArgs.AsEnum))
+ then
output_string opt.Lv6MainArgs.oc (LicDump.type_decl tn te)
)
this.types;
@@ -149,7 +156,7 @@ let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Lv6Id.idref option) =
*)
(match Lv6MainArgs.global_opt.Lv6MainArgs.expand_enums with
- | Lv6MainArgs.AsConst -> (
+ | Lv6MainArgs.AsConst -> if global_opt.kcg then () else (
let const_list =
ItemKeyMap.fold
(fun tn te acc ->
@@ -167,8 +174,8 @@ let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Lv6Id.idref option) =
let const = Lic.Extern_const_eff (elt, Lic.External_type_eff t) in
output_string opt.Lv6MainArgs.oc (LicDump.const_decl elt const))
const_list;
- )
- | Lv6MainArgs.AsInt -> (
+ )
+ | Lv6MainArgs.AsInt -> if global_opt.kcg then () else (
let const_list =
ItemKeyMap.fold
(fun tn te acc ->
@@ -188,6 +195,7 @@ let to_file (opt: Lv6MainArgs.t) (this:t) (main_node: Lv6Id.idref option) =
)
const_list;
)
+
| Lv6MainArgs.AsEnum -> ()
);
ItemKeyMap.iter
diff --git a/src/lv6util.ml b/src/lv6util.ml
index 24f7064f8b9d3fe926b7faa1feb848d580a36061..3cb9c4d440b7299f4d4b41965c9440594b610b0b 100644
--- a/src/lv6util.ml
+++ b/src/lv6util.ml
@@ -1,4 +1,6 @@
+open Lv6MainArgs
+
let my_string_of_float = string_of_float
let (entete : out_channel -> string -> string -> unit) =
@@ -11,7 +13,7 @@ let (entete : out_channel -> string -> string -> unit) =
else
acc ^ " " ^ x , (i+1+(String.length x))
)
- ("",0)
+ ("",0)
Sys.argv
and date = Printf.sprintf "%02d/%02d/%d"
(time.Unix.tm_mday)
@@ -33,8 +35,13 @@ let (entete : out_channel -> string -> string -> unit) =
Printf.fprintf oc "%s %s %s\n" cb sys_call ce;
Printf.fprintf oc "%s on %s the %s at %s %s\n" cb hostname date time_str ce
+
+
let (dump_entete : out_channel -> unit) =
- fun oc -> entete oc "(*" "*)"
+ fun oc -> if global_opt.kcg then
+ (entete oc "/*" "*/")
+ else
+ (entete oc "(*" "*)")
let rec pos_in_list i x l =
match l with