Some more work on the soc2c code generator.

Define the ctx typedef a good order (w.r.t. typedef dependancies).

src/soc2c.ml

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