Merge /home/ndiaye/lus2lic

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

src/licPrg.ml

 (* 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

src/lv6util.ml

 
+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