Fix: use tail recursive functions for manipulating list of variables.

(i.e., fold_left instead of map + flatten + @)

Indeed, for graphs of 10000 nodes on the dfs, we need to operate
on list of 100 000 000 variables, which overflow the stack.

lib/sasacore/main.ml

-(* Time-stamp: <modified the 08/10/2019 (at 16:28) by Erwan Jahier> *)
+(* Time-stamp: <modified the 17/10/2019 (at 11:12) by Erwan Jahier> *)
 
 open Register
 
@@ -44,7 +44,7 @@ let (dump_process: 'v Process.t * 'v Register.neighbor list -> unit) =
   fun (p,nl) ->
     let pvars = String.concat "," (SasaState.to_var_names p.pid p.init) in
     let neighbors = List.map StringOf.algo_neighbor nl in
-    Printf.printf "process %s\n\tvars:%s\n\tneighors: \n\t\t%s\n" p.pid  pvars
+    Printf.eprintf "process %s\n\tvars:%s\n\tneighors: \n\t\t%s\n%!" p.pid  pvars
       (String.concat "\n\t\t" neighbors)
 
 open Process
@@ -106,39 +106,60 @@ type 'v t = SasArg.t * 'v layout * 'v Env.t
 
 let (get_inputs_rif_decl: SasArg.t -> 'v Process.t list -> (string * string) list) =
   fun args pl -> 
-    if args.demon <> Custom then
-      if args.dummy_input then ["_dummy","bool"] else []
-    else 
-      let f p = List.map
-          (fun a -> p.pid ^(if a="" then "" else "_")^a ,"bool")
-          p.actions
-      in
-      List.flatten (List.map f pl)
+  if args.demon <> Custom then
+    if args.dummy_input then ["_dummy","bool"] else []
+  else 
+    let f acc p =
+      List.fold_left
+        (fun acc a -> (p.pid ^(if a="" then "" else "_")^a ,"bool")::acc)
+        acc
+        (List.rev p.actions)
+    in
+    List.fold_left f [] (List.rev pl)
 
 let (get_outputs_rif_decl: SasArg.t -> 'v Process.t list -> (string * string) list) =
-  fun args pl -> 
-    let ll = List.map 
-        (fun p ->
-           let l = SasaState.to_rif_decl p.pid p.init in
-           List.map (fun (n,t) -> n, Data.type_to_string t) l
+  fun args pl ->
+  (* This fonction  may be called on huge lists:  thus it must remains
+     tail-recursive and linear! *)
+  let pl = List.rev pl in
+  let vars = [] in
+  (* Adding action vars *)
+  let vars =
+    if args.demon = Custom then vars else
+      List.fold_left 
+        (fun acc p ->
+          List.fold_left
+            (fun acc a -> ((Printf.sprintf "%s_%s" p.pid a),"bool")::acc)
+            acc
+            p.actions
         )
-        pl
-    in
-    let algo_vars = List.flatten ll in 
-    let action_vars_enab = List.flatten
-        (List.map 
-           (fun p -> List.map
-               (fun a -> (Printf.sprintf "Enab_%s_%s" p.pid a),"bool") p.actions)
-           pl)
-    in
-    let action_vars = if args.demon = Custom then [] else
-        List.flatten
-          (List.map 
-             (fun p -> List.map
-                 (fun a -> (Printf.sprintf "%s_%s" p.pid a),"bool") p.actions)
-             pl)
-    in
-    algo_vars @ action_vars_enab @ action_vars
+        vars
+        pl    
+  in
+  (* Adding enable action vars *)
+  let vars = 
+    List.fold_left 
+      (fun acc p ->
+        List.fold_left
+          (fun acc a ->
+            ((Printf.sprintf "Enab_%s_%s" p.pid a),"bool")::acc)
+          acc
+          p.actions
+      )
+      vars
+      pl
+  in
+  (* Adding algo vars *)
+  let vars =
+    List.fold_left
+      (fun acc p ->
+        let l = SasaState.to_rif_decl p.pid p.init in
+        List.fold_left (fun acc (n,t) -> (n, Data.type_to_string t)::acc) acc l
+      )
+      vars
+      pl
+  in
+  vars
     
 let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) =
   fun args pl ->
@@ -147,7 +168,6 @@ let (env_rif_decl: SasArg.t -> 'v Process.t list -> string) =
       (List.map (fun (base, tstr) -> Printf.sprintf "\"%s\":%s" base tstr) ssl)
 
 
-
 let (make : bool -> string array -> 'v t) =
   fun dynlink argv ->
     let args = 
@@ -170,8 +190,7 @@ let (make : bool -> string array -> 'v t) =
       if args.output_algos then (
         let fl = List.map (fun n -> n.Topology.file) nl in
         let fl = List.sort_uniq compare fl in
-        Printf.printf "%s\n" (String.concat " " fl);
-        flush stdout;
+        Printf.printf "%s\n%!" (String.concat " " fl);
         exit 0
       );
       let cmxs = (Filename.chop_extension dot_file) ^ ".cma" in
@@ -186,9 +205,8 @@ let (make : bool -> string array -> 'v t) =
         GenRegister.f algo_files (ml_state_file, ml_register_file);
         Printf.printf "Hint: you may wish to generate %s out of %s with:\n"
           cmxs ml_register_file;
-        Printf.printf "   ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n"
+        Printf.printf "   ocamlfind ocamlopt -package algo -shared %s %s %s -o %s\n%!"
           ml_state_file ml_inputs ml_register_file cmxs;
-        flush stdout;
         exit 0
       );
 
@@ -204,7 +222,7 @@ let (make : bool -> string array -> 'v t) =
 
       Register.verbose_level := args.verbose;
       
-      if !Register.verbose_level > 0 then Printf.eprintf "nodes: %s\nedges:\n" nstr;
+      if !Register.verbose_level > 1 then Printf.eprintf "==> nodes: %s\n" nstr;
 
       if dynlink then (
         (* Dynamically link the cmxs file (not possible from rdbg) *)
@@ -226,60 +244,60 @@ let (make : bool -> string array -> 'v t) =
           nl
       in
 
+      if !Register.verbose_level > 0 then Printf.eprintf "==> get_neighors\n";
       let algo_neighors = List.map2 (get_neighors g) nidl initl in
       let pl = List.map2 (Process.make (args.demon=Custom)) nl initl in
       let e = Env.init () in
       let e = update_env_with_init e pl in
       let pl_n = List.combine pl algo_neighors in
-      if !Register.verbose_level > 0 then List.iter dump_process pl_n;
+      if !Register.verbose_level > 1 then List.iter dump_process pl_n;
       if args.gen_lutin then (
         let fn = (Filename.remove_extension args.topo) ^ ".lut" in
         if Sys.file_exists fn then (
-          Printf.eprintf "%s already exists: rename it to proceed.\n" fn;
-          flush stderr; exit 1
+          Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn;
+          exit 1
         ) else 
           let oc = open_out fn in
-          Printf.fprintf oc "%s" (GenLutin.f pl);
-          flush oc;
+          Printf.fprintf oc "%s%!" (GenLutin.f pl);
           close_out oc;
           exit 0);
       if args.gen_oracle then (
         let fn = (Filename.remove_extension args.topo) ^ "_oracle.lus" in
         if Sys.file_exists fn then (
-          Printf.eprintf "%s already exists: rename it to proceed.\n" fn;
-          flush stderr; exit 1
+          Printf.eprintf "%s already exists: rename it to proceed.\n%!" fn; exit 1
         ) else 
           let oc = open_out fn in
-          Printf.fprintf oc "%s" (GenOracle.f g pl);
-          flush oc;
+          Printf.fprintf oc "%s%!" (GenOracle.f g pl);
           close_out oc;
           exit 0);
       let seed = seed_get args in
       let oc = if args.rif then stderr else stdout in
+      if !Register.verbose_level > 0 then Printf.eprintf "==> open rif file...\n%!";
       Printf.fprintf oc "%s" (Mypervasives.entete "#" SasaVersion.str SasaVersion.sha);
       Printf.fprintf oc "#seed %i\n" seed;
-      let inputs_decl = get_inputs_rif_decl args pl in
-      Printf.printf "#inputs %s\n"
-        (String.concat " "
-           (List.map
-              (fun (vn,vt) -> Printf.sprintf "\"%s\":%s" vn vt) inputs_decl));
-      flush stdout;
-      Printf.printf "#outputs %s\n" (env_rif_decl args pl);
-      flush stdout;
+      if !Register.verbose_level > 0 then Printf.eprintf "==> get input var names...\n%!";
+      let inputs_decl = get_inputs_rif_decl args pl in 
+      Printf.printf "#inputs ";
+      List.iter (fun (vn,vt) -> Printf.printf "\"%s\":%s " vn vt) inputs_decl; 
+      Printf.printf "\n%!";
+      if !Register.verbose_level > 0 then Printf.eprintf "==> get output var names...\n%!";
+      Printf.printf "#outputs %s\n" (env_rif_decl args pl); 
+      Printf.printf "\n%!";
       if args.ifi then (
+        if !Register.verbose_level > 0 then Printf.eprintf "==> read bool...\n%!";
         List.iter
           (fun p -> List.iter
               (fun a -> ignore (RifRead.bool (args.verbose>1) p.pid a)) p.actions)
           pl;
-        Printf.eprintf "Ignoring the first vectors of sasa inputs\n";
-        flush stderr;
+        Printf.eprintf "Ignoring the first vectors of sasa inputs\n%!";
       );
+      if !Register.verbose_level > 0 then Printf.eprintf "==> Main.make done !\n%!";
       args, pl_n, e
     with
     | Dynlink.Error e ->
-      Printf.printf "Error (Sasacore.make): %s\n" (Dynlink.error_message e); flush stdout;
+       Printf.printf "Error when dynlinking (Sasacore.make): %s\n%!"
+         (Dynlink.error_message e); 
       exit 2
     | e ->
-      Printf.printf "Error (Sasacore.make): %s\n" (Printexc.to_string e);
-	   flush stdout;
+      Printf.printf "Error (Sasacore.make): %s\n%!" (Printexc.to_string e);
 	   exit 2