luc2c.ml

(*-----------------------------------------------------------------------
** Copyright (C) - Verimag.
** This file may only be copied under the terms of the GNU Library General
** Public License
**-----------------------------------------------------------------------
**
** File: luc2c.ml
** Author: jahier@imag.fr
**
** Generates C files to call Lucky from C.
**

*)

open LucProg


type gen_mode = Lustre | Scade | Alice | Luciole | Nop
type step_mode = Inside | Edges | Vertices

let step_mode_to_str = function 
    Inside  -> "step_inside"
  | Edges  -> "step_edges"
  | Vertices -> "step_vertices"

type optionT = {
  mutable pp : string option;
  mutable output : string option;
  mutable calling_module_name : string;
  mutable gen_mode : gen_mode;
  mutable use_sockets : bool;
  mutable step_mode : step_mode;
  mutable seed : int option;
  mutable env : string list;
  mutable sock_addr : string
}


let (option : optionT) = {
  pp = None;
  output = None;
  gen_mode = Nop;
  use_sockets = false;
  calling_module_name = "XXX_SCADE_MODULE_NAME";
  step_mode = Inside;
  seed = None;
  env = [];
  sock_addr = "127.0.0.1"
}


(****************************************************************************)

let (gen_lustre_ext_h : string -> unit) =
  fun fn  -> 
    let oc = open_out (option.calling_module_name ^ "_ext.h") in
    let putln s = output_string oc (s^"\n") in
      putln (Util.entete "// ");
      putln ("#include \"" ^ option.calling_module_name ^ "_ext_func.h\"");
      flush oc;
      close_out oc
             
let (gen_lustre_ext_func_h : string -> Exp.var list -> Exp.var list -> unit) =
  fun fn in_vars out_vars -> 
    let oc = open_out (option.calling_module_name ^ "_ext_func.h") in
    let put s = output_string oc s in
    let putln s = output_string oc (s^"\n") in
    let rec putlist = function
        [] -> ()
      | [x] -> put x
      | x::l' -> put x; put ", "; putlist l'
    in 
      putln (Util.entete "// ");
      putln  ("#include \"" ^ option.calling_module_name ^ ".h\"");
      putln  ("#include \"" ^ fn ^ ".h\"");
      putln "#define bool int";
      putln "";

      putln ("// A C function that implements "^fn^" which profile is the one ");
      putln "// expected when calling an external C function from Lustre.";
      put ("extern void " ^ fn ^ "(");
      putln "";
      let l1 = List.fold_left
        (fun acc var -> acc @ [(Type.to_cstring (Var.typ var)) ^ "*"])
        []
        out_vars
      in 
      let l2 = List.fold_left
        (fun acc var -> acc @ [Type.to_cstring (Var.typ var)])
        l1
        in_vars
      in
        putlist l2;
        putln ");";

        flush oc;
        close_out oc
             
let (gen_lustre_ext_func_c : string -> Exp.var list -> Exp.var list -> unit) =
  fun fn in_vars out_vars -> 
    let oc = open_out (option.calling_module_name ^ "_ext_func.c") in
    let put s = output_string oc s in
    let putln s = output_string oc (s^"\n") in
    let rec putlist = function
        [] -> ()
      |        [x] -> put x
      | x::l' -> put x; put ", "; putlist l'
    in 
      putln (Util.entete "// ");
      putln  ("#include \"" ^ option.calling_module_name ^ "_ext_func.h\"");
      putln "";

      putln "// Output procedures";
      List.iter
        (fun var -> 
           put ("void " ^ fn ^ "_O_" ^ (Var.name var) ^ "(" ^
                  fn  ^"_ctx* lucky_ctx, ");
           put ((Type.to_cstring (Var.typ var)) ^ " v) { lucky_ctx->_");
           putln ((Var.name var) ^ " = v; };");
        )
        out_vars;
      
      putln "";
      putln "#define false 0";
      putln "#define true 1";

      putln (fn ^ "_ctx* lucky_ctx;");
      putln "int not_init = true;";
      putln "";
      put ("void " ^ fn ^ "(");
      let l1 = List.fold_left
        (fun acc var -> 
           acc @ [(Type.to_cstring (Var.typ var)) ^ "* " ^ (Var.name var)])
        []
        out_vars
      in 
      let l2 = List.fold_left
        (fun acc var -> acc @ [Type.to_cstring (Var.typ var)^" "^(Var.name var)])
        l1
        in_vars
      in
        putlist l2;
        putln "){";
        
        putln "";
        putln ("  if (not_init) {
    lucky_ctx = "^fn^"_new_ctx(NULL);
    not_init = false;");
        (match option.seed with
            None -> ()
          | Some i -> putln ("    lucky_set_seed(" ^ (string_of_int i) ^ ");");
        );
        putln "  };";
        List.iter
          (fun var -> 
             put ("  "^fn ^ "_I_" ^ (Var.name var) ^ "(lucky_ctx, ");
             putln ((Var.name var) ^ ");")
          )
          in_vars;
      
        putln ("  "^fn^ "_step(lucky_ctx, "^ (step_mode_to_str option.step_mode)^ ");");
        List.iter
          (fun var -> 
             putln ("  *" ^ (Var.name var) ^ "=lucky_ctx->_" ^(Var.name var) ^ ";");
          )
          out_vars;
        putln "}";
        putln "";
        
        
        flush oc;
        close_out oc




(****************************************************************************)
let (gen_h_file : string -> Exp.var list -> Exp.var list -> Exp.var list -> unit) =
  fun fn in_vars out_vars loc_vars ->
    let oc = open_out (fn ^ ".h") in
    let put s = output_string oc s in
    let putln s = output_string oc (s^"\n") in
    let max_buff_size =
      (* 10 digits per I/O is enough? *)
      let in_nb = List.length in_vars in
      let out_nb = List.length out_vars in
      let io_size = 10 in
        2 lsl (int_of_float (log (float_of_int (20+io_size*(in_nb+out_nb))) /. (log 2.))) 
    in
    let put_var_decl_in_struct var =
      put "  ";
      put (Type.to_cstring (Var.typ var));
      put " _";
      put (Var.name var);
      putln ";";
    in
      
      putln (Util.entete "// ");
      
      putln  ("#ifndef _" ^ fn ^ "_H_INCLUDED \n");
      putln  ("#define _" ^ fn ^ "_H_INCLUDED \n");
      if not option.use_sockets then
        putln  "#include <luc4c_stubs.h> \n";
      putln "#include <stdio.h>";

      putln "//-------- Predefined types ---------";
      putln "#ifndef _EC2C_PREDEF_TYPES
#define _EC2C_PREDEF_TYPES
typedef int _bool;
typedef int _boolean;
typedef int _int;
typedef int _integer;
typedef char* _string;
typedef double _real;
typedef double _double;
typedef float _float;
#define _false 0
#define _true 1
#endif
";
      if option.use_sockets then (
        putln ("#define MAX_BUFF_SIZE "^(string_of_int max_buff_size)^"");
        putln ("#define MAX_BUFF_SIZE_4 "^(string_of_int (4*max_buff_size))^"");
      );
      putln "//--------- Pragmas ----------------";
      putln ("//MODULE: " ^ fn ^ " " ^ (string_of_int (List.length in_vars)) 
             ^ " " ^  (string_of_int (List.length out_vars)));
      List.iter
        (fun var -> 
           putln ("//IN: " ^ (Type.to_cstring (Var.typ var)) ^ " " ^(Var.name var))
        )
        in_vars;
      List.iter
        (fun var -> 
           putln ("//OUT: " ^ (Type.to_cstring (Var.typ var)) ^ " " ^(Var.name var))
        )
        out_vars;


      putln ("\n//--------Context type ------------");
      putln "/*--------";
      putln "Internal structure for the call";
      putln "--------*/";


      putln "";
      if option.gen_mode = Scade then 
        (

          putln ("/* \n// Put the following in the scade generated file " ^ fn ^
                   "_fctext.h\n// (#included hereafter), " ^
                   "before the definition of the structure \n// _C_"  
                 ^ fn ^ ".");
          putln ("// Also, add the following field to the structure _C_"  ^ 
                   fn ^ ":");
          putln ("// ==>   " ^ fn ^ "_ctx * scade_ctx;\n");
        );
      putln ("struct C_" ^ fn ^ ";");
      putln ("struct _" ^ fn ^ "_ctx");
      putln " {";
      putln "  void* client_data;";
      putln "  //INPUTS";
      List.iter put_var_decl_in_struct in_vars;
      putln "  //OUTPUTS";
      List.iter put_var_decl_in_struct out_vars;

      putln "  ";
      put "  // lucky process number";
      put "  
#ifndef _WIN32
   int lp;
#endif
";
      if option.use_sockets then (
        putln "  char buff [MAX_BUFF_SIZE];";
        putln "  int sock;";
      );
      if option.gen_mode = Scade then (
        putln "  // Scade node context";
        putln ("   struct C_" ^ option.calling_module_name ^ " * client_data;");
        putln "};\n";
        putln ("typedef struct _" ^ fn ^ "_ctx " ^ fn ^ "_ctx;\n");
        putln "*/\n";
        putln ("#include \""^ fn ^"_fctext.h\"\n\n");
      )
      else
        (
          putln "};\n";
          putln ("typedef struct _" ^ fn ^ "_ctx " ^ fn ^ "_ctx;\n");
        );

      putln "FILE* fp;";
      putln "// To be defined by users";
      List.iter
        (fun var -> 
           put ("extern void " ^ fn ^ "_O_" ^ (Var.name var) ^ "(" ^
                  fn  ^"_ctx* ctx, ");
           put ((Type.to_cstring (Var.typ var)) ^ " f);\n");
        )
        out_vars;

      putln "\n//--------Context allocation --------";
      putln ("extern "^fn^"_ctx* "^fn^"_new_ctx(void* client_data);");


      putln ("\n//-------Context copy --------------");
      putln ("extern void "^fn^"_copy_ctx("^fn^"_ctx* dest, "^ fn ^
               "_ctx* src);");

      if option.use_sockets then (
        putln "\n//--------Terminate procedure -----------";
        putln ("extern void "^fn^"_terminate("^fn^"_ctx* ctx);");
      );
      putln "\n//--------Reset procedure -----------";
      putln ("extern void "^fn^"_reset("^fn^"_ctx* ctx);");


      putln ("\n//-------Step procedure -----------");

      if option.use_sockets then
        putln ("extern void "^fn^"_step("^fn^"_ctx* ctx);")
      else
        putln ("extern void "^fn^"_step("^fn^"_ctx* ctx, step_mode sm);");

      putln ("\n//-------Input procedures ---------");
      List.iter
        (fun var -> 
           put ("extern void " ^ fn ^ "_I_" ^ (Var.name var) ^ 
                  "("^fn^"_ctx*, ");
           put ((Type.to_cstring (Var.typ var)) ^ ");\n");
        )
        in_vars;

      putln  "#endif \n";
      
      flush oc;
      close_out oc

let var_to_format_print var =
  match Var.typ var with
    | Type.BoolT -> "%d"
    | Type.IntT -> "%d"
    | Type.FloatT -> "%lf"
    | Type.UT _ -> assert false

let var_to_format_scan var =
  match Var.typ var with
    | Type.BoolT -> "%c"
    | Type.IntT -> "%d"
    | Type.FloatT -> "%lf"
    | Type.UT _ -> assert false

let var_to_cast var =
  match Var.typ var with
    | Type.BoolT -> ""
    | Type.IntT -> ""
    | Type.FloatT -> "(float)"
    | Type.UT _ -> assert false


let put_socket_func put fn in_vars out_vars loc_vars =
  let putln str = put (str^"\n") in
    put ("
#include <stdio.h>
#include <sys/types.h>
#include <signal.h>
#ifdef _WINSOCK
  #include <windows.h>
  #include <process.h>
  #pragma comment(lib, \"Ws2_32.lib\")
#else
  #include <sys/socket.h>
  #include <netinet/in.h>
  #include <netdb.h>
#endif

#ifdef _DEBUG
#define dbg_printf(...) fprintf(fp, __VA_ARGS__); fflush(fp)
#else
#define dbg_printf(...)  while(0)
#endif

/*--------
Output procedures must be defined,
Input procedures must be used:
--------*/
");       
    List.iter
      (fun var -> 
         put ("void " ^ fn ^ "_I_" ^ (Var.name var) ^ 
                "(" ^ fn ^ "_ctx* ctx, ");
         put ((Type.to_cstring (Var.typ var)) ^ " _" ^ (Var.name var)^ "){\n");
         putln ("  ctx->_" ^ (Var.name var) ^ " = _" ^ (Var.name var)^ ";");
         putln "}\n";
      )
      in_vars;
    
    putln ("
/*--------
launch the lutin interpreter and init socket stuff
--------*/
" ^ fn ^ "_ctx* " ^ fn ^ "_new_ctx(void* cdata){
  " ^ fn ^ "_ctx* ctx;     
  int sockfd;
  int newsockfd;
  int portno;
  int clilen;
  int rc;
#ifndef _WIN32
  int lutin_pid;
#endif
  struct sockaddr_in serv_addr;
  struct sockaddr_in cli_addr;
  char portno_str[10];
  char buff[MAX_BUFF_SIZE_4];
  char *sock_addr = \""^option.sock_addr^"\";
  const char *args[] = { 
#ifdef _WIN32
    \"call-via-socket.exe\", sock_addr, portno_str, \"lutin.exe\",
#else
    \"call-via-socket\", sock_addr, portno_str, \"lutin\",
#endif 
   " ^
             (match option.seed with None -> "" | Some i -> ("\"-seed\", \""^(string_of_int i)^"\", "))
           ^" \""^
(List.hd option.env) (* only work with lutin XXX fixme! *)

           ^"\", \"-rif\",\""^fn^".rif\", NULL};

  
  // Socket administration stuff   
#ifdef _WINSOCK
  WSADATA WSAData;
  WSAStartup(MAKEWORD(2,0), &WSAData);
#endif

  ctx = malloc(sizeof("^ fn ^ "_ctx));
  ctx->client_data = cdata;

  sockfd = socket(AF_INET, SOCK_STREAM, 0);
  if (sockfd < 0) printf(\"Error: opening socket\");
  serv_addr.sin_family = AF_INET;
  serv_addr.sin_addr.s_addr = inet_addr(sock_addr);

  portno = 2000;
  serv_addr.sin_port = htons(portno);
  while (bind(sockfd, (struct sockaddr *) &serv_addr, sizeof(serv_addr)) ) {
    portno++;
    dbg_printf(\"Binding  %s:%d...\\n\",sock_addr,portno);
    serv_addr.sin_port = htons(portno);
    if (portno > 4000) { printf(\"Error: cannot bind socket\\n\"); exit(2); }
  };
  
  sprintf(portno_str, \"%d\", portno);
#ifndef _LAUNCH_LUTIN_AUTOMATICALLY
  printf(\" >>> Waiting for lutin to connect on %s:%s\\n\", sock_addr, portno_str);
#else
  dbg_printf(\"Forking...%d\\n\",portno);
#ifdef _WIN32
  _spawnvp(_P_DETACH,  args[0], args);
#else
  lutin_pid = fork();
  if(lutin_pid == 0) {
    execvp(args[0], args);
    printf(\"Unknown command\\n\");
    return 0;
  }
#endif
#endif 

  dbg_printf(\"Listening...\\n\");
  listen(sockfd,5);
  clilen = sizeof(cli_addr);
  dbg_printf(\"Accepting...\\n\");
  newsockfd = accept(sockfd, (struct sockaddr *) &cli_addr, &clilen);
  if (newsockfd < 0) printf(\"Error:  on accept\");
  ctx->sock = newsockfd;
  rc = recv(ctx->sock, buff, MAX_BUFF_SIZE_4, 0);
  if (rc<0)  { printf(\"Error: cannot read on socket\\n\"); exit(2); }
  dbg_printf(\"Skipping '%s'\\n\", ctx->buff);

  memset(ctx->buff, 0, MAX_BUFF_SIZE);
#ifndef _WIN32
  ctx->lp = lutin_pid;
#endif

  return ctx;
}

/*--------
Step procedure
--------*/

void " ^ fn ^ "_step(" ^ fn ^ "_ctx* ctx){
  int rc;
  int i;
" ^
let cpt = ref 0 in
let decl_char acc var =
  if (Var.typ var= Type.BoolT) then (
    incr cpt; 
    ("  char c"^(string_of_int !cpt)^";\n")::acc)
  else
    acc
in
let char_decl =
  (String.concat "" (List.rev (List.fold_left decl_char [] out_vars)))
in
  (if !cpt = 0 then "" else char_decl) ^ "
  sprintf(ctx->buff, \""^(
    List.fold_left
      (fun acc var -> acc ^ (var_to_format_print var) ^ " ")
      ""
      in_vars) ^"\\n\", "
  ^
    let var_to_adress var ="ctx->_" ^ (Var.name var) in
      (List.fold_left
         (fun acc var -> acc ^ ", "^ (var_to_adress var))
         (var_to_adress (List.hd in_vars))
         ((List.tl in_vars)))
      ^
        ");
  dbg_printf(\"\\n\\n ---- A new Step begins. Sending to sock: '%s'\\n\",ctx->buff);
  send(ctx->sock, ctx->buff, (int) strlen(ctx->buff),0);
  dbg_printf(\"reading inputs\\n\");

  rc = 0;
  rc = recv(ctx->sock, ctx->buff, MAX_BUFF_SIZE, 0);
  if (rc<0)  { printf(\"Error: cannot read on socket\\n\"); exit(2); }
  dbg_printf(\"reading '%s'\\n\",ctx->buff);
  sscanf(ctx->buff, \"#step %d #outs " ^ 
        let cpt = ref 0 in
        let var_to_adress var =
          if (Var.typ var= Type.BoolT) then (
            incr cpt; "&c"^(string_of_int !cpt))
          else
            "&(ctx->_"^ (Var.name var)^")"
        in
          (List.fold_left
             (fun acc var -> acc ^ " " ^ (var_to_format_scan var))
             ""
             out_vars)^"\", &i," 
          ^
            (List.fold_left
               (fun acc var -> acc^", "^(var_to_adress var))
               (var_to_adress (List.hd out_vars))
               (List.tl out_vars)) ^ ");
" ^
            let cpt = ref 0 in
            let copy_char_to_ctx acc var =
              if (Var.typ var= Type.BoolT) then (
                incr cpt; 
                let c = ("c"^(string_of_int !cpt)) in
                let conv_char = 
                  "   if (("^c^" == '0') || ("^c^" == 'f') || ("^c^" == 'F')) ctx->_"
                  ^(Var.name var)^" = _false;
   if (("^c^" == '1') || ("^c^" == 't') || ("^c^" == 'T')) ctx->_"
                  ^(Var.name var)^" = _true;
"
                in
                  conv_char::acc)
              else
                acc
            in
              (String.concat ""
                 (List.rev (List.fold_left copy_char_to_ctx [] out_vars)))
              ^ "
   memset(ctx->buff, 0, rc);       
   dbg_printf(\"----- step done\\n\");
}

/*--------
Terminate procedure
--------*/

void " ^ fn ^ "_terminate(" ^ fn ^ "_ctx* ctx){
  send(ctx->sock, \"q\\n\", 2, 0);
#ifdef _WINSOCK
  WSACleanup();
#else
  close(ctx->sock);
  kill(ctx->lp, SIGKILL); // parano
#endif
}

/*--------
Reset procedure
--------*/

void " ^ fn ^ "_reset(" ^ fn ^ "_ctx* ctx){
  " ^ fn ^ "_terminate(ctx);
  ctx = " ^ fn ^ "_new_ctx(ctx->client_data);
}")



let (gen_c_file : string -> Exp.var list -> Exp.var list -> Exp.var list -> unit) =
  fun fn in_vars out_vars loc_vars -> 
    let oc = 
      if option.gen_mode = Scade then
        open_out (fn ^ "_fctext.c")         
      else
        open_out (fn ^ ".c") 
    in
    let put s = output_string oc s in
    let putln s = output_string oc (s^"\n") in
      (*     let in_out_vars = in_vars @ out_vars in *)

      putln (Util.entete "// ");
      put (( if option.gen_mode = Scade then
                 "#include \"" ^ option.calling_module_name ^ ".h\" \n" 
               else
                 "#include \"" ^ fn ^ ".h\" \n" 
             ) ^
             "");

      if option.use_sockets then (
        put "
#include <stdlib.h>
#include <string.h>
";
        put_socket_func put fn in_vars out_vars loc_vars;
      )
      else (
        if option.gen_mode = Scade then 
          begin
            (*           putln ("static " ^ fn ^ "_ctx* ctx;\n");       *)
            putln "
/*------
Output procedures
--------*/
";        
            List.iter
              (fun var -> 
                 put ("void " ^ fn ^ "_O_" ^ (Var.name var));
                 put ("("^ fn ^ "_ctx* ctx, " ^ (Type.to_cstring (Var.typ var)));
                 putln (" "^(Var.name var) ^ ") {");
                 put ("  ctx->client_data->_<SCADE_VAR_NAME_OF_" ^ (Var.name var));
                 putln ("> = " ^ (Var.name var) ^ ";");
                 putln "  return;";
                 putln "}\n";
              )
              out_vars;
            putln "/*------
Input procedures
--------*/
";        
          end
        else 
          begin
            putln "
/*--------
Output procedures must be defined,
Input procedures must be used:
--------*/

";
          end;
        
        List.iter
          (fun var -> 
             put ("void " ^ fn ^ "_I_" ^ (Var.name var) ^ 
                    "(" ^ fn ^ "_ctx* ctx, ");
             put ((Type.to_cstring (Var.typ var)) ^ " _" ^ (Var.name var)^ "){\n");
             putln ("  ctx->_" ^ (Var.name var) ^ " = _" ^ (Var.name var)^ ";");
             putln "}\n";
          )
          in_vars;
        
        putln ("/*--------
Copy the value of an internal structure
--------*/
void "^ fn ^"_copy_ctx("^ fn ^"_ctx* dest, "^ fn ^"_ctx* src){
  memcpy((void*)dest, (void*)src, sizeof("^ fn ^"_ctx));
}");

      putln "
/*--------
Dynamic allocation of an internal structure
--------*/";
      putln (fn ^ "_ctx* " ^ fn ^ "_new_ctx(void* cdata){");
      putln ("  " ^ fn ^ "_ctx* ctx;");
      putln "";
      putln "  lucky_caml_init();";
      putln ("  ctx = malloc(sizeof("^ fn ^ "_ctx));");
      putln "  ctx->client_data = cdata;";
      put  ("  ctx->lp = make(" );
      put (match option.pp with | None -> "\"\"" | Some pp -> ("\""^pp^"\""));
      put (", \"");
      assert (option.env <> []);
      put (List.hd option.env);
      List.iter (fun x -> put (" " ^ x)) (List.tl option.env);
      putln "\");";
      
      putln "  return ctx;";
      putln "}";

      putln "
/*--------
Step procedure
--------*/";

      put ("void " ^ fn ^ "_step(" ^ fn ^ "_ctx* ctx, step_mode sm){\n");
      
      List.iter
        (fun var ->
           putln ("  lucky_set_input_" ^
                    (Type.to_string (Var.typ var)) ^ "(ctx->lp, \"" ^
                    (Var.name var) ^ "\", ctx->_" ^
                    (Var.name var) ^");");
        )
        in_vars;
      
      putln "  lucky_step(ctx->lp, sm);";

      List.iter
        (fun var -> 
           putln ("  " ^ fn ^ "_O_" ^ (Var.name var) ^ 
                    "(ctx, lucky_get_output_" ^
                    (Type.to_string (Var.typ var)) ^ "(ctx->lp, \"" ^
                    (Var.name var) ^ "\"));");
        )
        out_vars;
      putln "}";

      putln "
/*--------
Reset procedure
--------*/";
      put ("void " ^ fn ^ "_reset(" ^ fn ^ "_ctx* ctx){\n");
      put  ("  ctx->lp = make(" );
      put (match option.pp with | None -> "\"\"" | Some pp -> ("\""^pp^"\""));
      put (", \"");
      assert (option.env <> []);
      put (List.hd option.env);
      List.iter (fun x -> put (" " ^ x)) (List.tl option.env);
      putln "\");";
      
      putln "}";

      if option.gen_mode = Scade then (
        putln "

/*------
This is the main function to be called by Scade
--------*/";

        putln ("void " ^ option.calling_module_name ^ "_init(_C_" ^ 
                 option.calling_module_name ^ " * _C_)");
        putln "{";
        putln ("  _C_->lucky_ctx = " ^ fn ^ "_new_ctx(_C_);");
        putln "}";

        put ("void " ^ option.calling_module_name ^ "(_C_" ^ 
               option.calling_module_name ^ " *_C_){");

        putln "\n  // sets the inputs";
        List.iter 
          (fun var -> 
             put ("  " ^ fn ^ "_I_"^ (Var.name var) ^ "(_C_->lucky_ctx, ");
             putln ((Var.name var) ^ ");")
          )
          in_vars;
        
        putln "\n  // perform the step";
        putln ("  " ^ fn ^ "_step(_C_->lucky_ctx, step_inside);");
        
        putln "}"; 
      );
      );
      
      flush oc;
      close_out oc

(****************************************************************************)
(*
  Invent a file name from the list of file names, unless one was provided
  at the command line.
*)

let (build_file_name : string list -> string) =
  fun el ->
    let change_file_name f =
      (* make sure that there is no strange char in the name of the
         file as it will be used as a C ident.
         Therefore, we replace " " and "-" by "_".
         Is there any other problematic chars?
      *)
      let f0 = (Filename.basename (Filename.chop_extension f)) in
      let f1 = Str.global_replace (Str.regexp " ") "_" f0 in
      let f2 = Str.global_replace (Str.regexp "-") "_" f1 in
        f2
    in
      match option.output with
          None -> 
            let fn = 
              assert (el <> []);
              List.fold_left 
              (fun f acc -> (acc^"_"^(change_file_name f))) 
                (change_file_name (List.hd el))
                (List.tl el) 
            in
              option.output <- Some fn;
              fn
        | Some fn -> fn


(****************************************************************************)
open Prog

let (main : unit -> unit) =
  fun _ ->
    let env_list = option.env in
    let state = LucProg.make_state option.pp env_list in
    let _ =  assert (env_list <> []) in
    let from_lutin = Util.get_extension (List.hd env_list) = ".lut"  in
    let fn = build_file_name env_list in
    let _ = 
      gen_c_file fn state.s.in_vars state.s.out_vars state.s.loc_vars;
      gen_h_file fn state.s.in_vars state.s.out_vars state.s.loc_vars
    in
    let gen_files_for_lustre () =
      gen_lustre_ext_func_c fn state.s.in_vars state.s.out_vars ;
      gen_lustre_ext_func_h fn state.s.in_vars state.s.out_vars ;
      gen_lustre_ext_h fn
    in
      (match option.gen_mode with
         | Nop -> ()
         | Lustre -> gen_files_for_lustre ()
         | Luciole -> 
             let var_to_vn_ct v =
               (Var.name v, 
                Type.to_cstring (Var.typ v)
               )
             in
               Luciole.gen_stubs false from_lutin fn
                 (List.map var_to_vn_ct state.s.in_vars)
                 (List.map var_to_vn_ct state.s.out_vars)
         | Scade -> ()
         | Alice ->
             let alice_args = {
               Luc2alice.env_name = fn;
               Luc2alice.alice_module_name = option.calling_module_name ;
               Luc2alice.seed = option.seed;
               Luc2alice.env_in_vars = state.s.in_vars ;
               Luc2alice.env_out_vars = state.s.out_vars ;
               Luc2alice.use_sockets = option.use_sockets ;

             }
             in
               Luc2alice.gen_alice_stub_c alice_args;
               Luc2alice.gen_alice_stub_h alice_args;
      )