diff --git a/src/soc2c.ml b/src/soc2c.ml
index 2f7c835f7742d7553c33a446042a7c90d86108ff..67afbbee5ab9553eb3bc40f15b1d7db74a6cf038 100644
--- a/src/soc2c.ml
+++ b/src/soc2c.ml
@@ -1,4 +1,4 @@
-(* Time-stamp: <modified the 02/06/2014 (at 15:54) by Erwan Jahier> *)
+(* Time-stamp: <modified the 04/06/2014 (at 17:22) by Erwan Jahier> *)
(* let put (os: out_channel) (fmt:('a, unit, string, unit) format4) : 'a = *)
@@ -177,17 +177,7 @@ let (soc2c: int -> out_channel -> out_channel -> Soc.tbl -> Soc.t -> unit) =
let hput str = output_string hfile str in
let cput str = output_string cfile str in
let put str = cput str; hput str in
- let fmt f str = cfmt f str; hfmt f str in
- let string_of_instance (id,sk) =
- let (sk_id,tl,init_opt) = sk in
- let init = match init_opt with
- | Soc.Nomore -> ""
- | Soc.Slic(_,_,_) -> assert false (* fixme *)
- | Soc.MemInit(ve) -> Printf.sprintf " = %s" (string_of_var_expr soc ve)
- in
- Printf.sprintf " %s_type %s%s;\n" (get_ctx_name sk) (id2s id) init
- in
-
+ let fmt f str = cfmt f str; hfmt f str in
let name, _,_ = soc.key in
let name = id2s name in
let il,ol = soc.profile in
@@ -195,22 +185,6 @@ let (soc2c: int -> out_channel -> out_channel -> Soc.tbl -> Soc.t -> unit) =
let ctx_name = get_ctx_name soc.key in
let ctx_name_type = ctx_name^"_type" in
if pass=1 then (
- hfmt "/* %s */\ntypedef struct {\n /*INPUTS*/\n" ctx_name;
- List.iter (fun v -> hput (string_of_flow_decl v)) il ;
-
- hput " /*OUTPUTS*/\n";
- List.iter (fun v -> hput (string_of_flow_decl v)) ol ;
-
- (match soc.have_mem with
- | None -> ()
- | Some t ->
- hput " /*Memory cell*/\n";
- hfmt " %s mem_pre;\n" (id2s (Data.type_to_string t));
- );
-
- if soc.instances <> [] then hput " /*INSTANCES*/\n";
- List.iter (fun inst -> hput (string_of_instance inst)) soc.instances;
- hfmt "} %s;\n\n" ctx_name_type;
(* Only for ctx of memoryless nodes + main node *)
if is_memory_less soc then cfmt "%s %s;\n" ctx_name_type ctx_name;
) else (
@@ -231,6 +205,18 @@ let (soc2c: int -> out_channel -> out_channel -> Soc.tbl -> Soc.t -> unit) =
()
)
+(****************************************************************************)
+let (type_to_format_string : Data.t -> string) =
+ function
+ | Bool -> "%d"
+ | Int -> "%d"
+ | Real-> "%g"
+ | Extern s -> assert false
+ | Enum (s, sl) -> "%d"
+ | Struct (sid,_) -> assert false
+ | Array (ty, sz) -> assert false
+ | Alpha nb -> assert false
+
(****************************************************************************)
let rec (lic_type_to_c: Lic.type_ -> string) =
function
@@ -253,15 +239,78 @@ let rec (lic_type_to_c: Lic.type_ -> string) =
| (TypeVar AnyNum) -> assert false
-let (typedef : LicPrg.t -> string) =
- fun licprg ->
- let to_c k t =
- Printf.sprintf "typedef %s %s;\n"
- (lic_type_to_c t)
- (long2s k)
+(****************************************************************************)
+
+let (typedef_of_soc : Soc.t -> string) =
+ fun soc ->
+ let ctx_name = get_ctx_name soc.key in
+ let ctx_name_type = ctx_name^"_type" in
+ let il,ol = soc.profile in
+ let str = Printf.sprintf "/* %s */\ntypedef struct {\n /*INPUTS*/\n" ctx_name in
+ let str = List.fold_left (fun acc v -> acc^ (string_of_flow_decl v)) str il in
+ let str = str ^ " /*OUTPUTS*/\n" in
+ let str = List.fold_left (fun acc v -> acc^ (string_of_flow_decl v)) str ol in
+ let str = str ^
+ (match soc.have_mem with
+ | None -> ""
+ | Some t ->
+ Printf.sprintf " /*Memory cell*/\n %s mem_pre;\n" (id2s (Data.type_to_string t))
+ )
+ in
+ let str = str ^ (if soc.instances <> [] then " /*INSTANCES*/\n" else "") in
+ let string_of_instance (id,sk) =
+ let (sk_id,tl,init_opt) = sk in
+ let init = match init_opt with
+ | Soc.Nomore -> ""
+ | Soc.Slic(_,_,_) -> assert false (* fixme *)
+ | Soc.MemInit(ve) -> Printf.sprintf " = %s" (string_of_var_expr soc ve)
+ in
+ Printf.sprintf " %s_type %s%s;\n" (get_ctx_name sk) (id2s id) init
in
- LicPrg.fold_types (fun k t acc -> acc ^ (to_c k t)) licprg "// Type definitions \n"
+ let str = List.fold_left (fun acc inst -> acc^(string_of_instance inst)) str soc.instances in
+ let str = Printf.sprintf "%s} %s;\n\n" str ctx_name_type in
+ str
+let (typedef : LicPrg.t -> Soc.tbl -> Soc.t -> string) =
+ fun licprg soc_tbl main_soc ->
+ (* We need to print the ctx typedef a good order
+ (w.r.t. typedef dependancies). To do that, we traverse
+ the tree of soc instances which root is the main soc. *)
+ let rec (soc_with_mem : string -> Soc.t -> string) =
+ fun acc soc ->
+ let acc = (typedef_of_soc soc) ^ acc in
+ List.fold_left
+ (fun acc (iname, sk) ->
+ let soc = SocUtils.find_no_exc sk soc_tbl in
+ soc_with_mem acc soc
+ )
+ acc soc.instances
+ in
+ let soc_ctx_typedef_with = soc_with_mem "" main_soc in
+ (* Then we still have to print memoryless soc that can not appear
+ as a soc instance *)
+ let soc_ctx_typedef_without =
+ let socs = Soc.SocMap.bindings soc_tbl in
+ let socs = snd (List.split socs) in
+ let memless_soc_to_string acc soc =
+ if is_memory_less soc then acc^(typedef_of_soc soc) else acc
+ in
+ List.fold_left memless_soc_to_string "" socs
+ in
+ (* There are also typedef that comes from user in Lustre V6 *)
+ let user_typedef =
+ let to_c k t =
+ Printf.sprintf "typedef %s %s;\n" (lic_type_to_c t) (long2s k)
+ in
+ LicPrg.fold_types (fun k t acc -> acc ^ (to_c k t)) licprg "// Type definitions \n"
+ in
+ "// user type def \n"^user_typedef
+ ^"// Memoryless soc ctx typedef \n"^soc_ctx_typedef_without
+ ^"// Memoryfull soc ctx typedef \n"^soc_ctx_typedef_with
+
+
+
+(****************************************************************************)
let rec (const_to_c: Lic.const -> string) =
function
| Bool_const_eff true -> "1"
@@ -428,13 +477,20 @@ int main(){
fflush(stdout);
++s;
");
+ let inputs,outputs = soc.profile in
List.iter (fun (id,t) ->
let t = Data.type_to_string t in
let str = Printf.sprintf " ctx->%s = _get_%s(\"%s\");\n" id t id in
putc str
- )
- (fst soc.profile);
+ )
+ inputs;
+ let inputs_fmt = List.map (fun (_,t) -> type_to_format_string t) inputs in
+ let outputs_fmt = List.map (fun (_,t) -> type_to_format_string t) outputs in
putc (" " ^ step^"(ctx);
+ printf(\"" ^ (String.concat " " inputs_fmt)^ " #outs " ^
+ (String.concat " " outputs_fmt)^ "\\n\"," ^
+ (String.concat "," (List.map (fun (id,_) -> "ctx->"^id ) (inputs@outputs)))^
+ ");
first_step=_false;
}
return 1;
@@ -458,11 +514,11 @@ let (f : Lv6MainArgs.t -> Soc.key -> Soc.tbl -> LicPrg.t -> unit) =
let och = open_out hfile in
let putc s = output_string occ s ; flush occ in
let puth s = output_string och s ; flush och in
-
+ let main_soc = Soc.SocMap.find msoc stbl in
Lv6util.entete occ "/*" "*/" ;
Lv6util.entete och "/*" "*/";
- gen_loop_file (Soc.SocMap.find msoc stbl);
+ gen_loop_file main_soc;
output_string och "
#include <stdlib.h>
@@ -482,11 +538,10 @@ typedef float _float;
";
putc "#include \"hfile.h\"\n";
- puth (typedef licprg);
+ puth (typedef licprg stbl main_soc );
putc (constdef licprg);
puth "/////////////////////////////////////////////////\n";
puth "// ctx type definitions\n";
- putc "/////////////////////////////////////////////////\n";
putc "// Allocating memoryless ctx\n";
List.iter (soc2c 1 och occ stbl) socs;
puth "/////////////////////////////////////////////////\n";