Refactored Misc

Created two new files: 
 - utilities/global/compiler_options.ml: contains
 the options that can be set using the cli
 - utilities/global/errors.ml: contains global
 errors definition

Misc now only contains helper functions that have 
nothing to do with the ast or the compiler.

compiler/global/global_mapfold.ml

@@ -1,4 +1,5 @@
 open Misc
+open Errors
 open Types
 (*open Clocks*)
 open Signature

compiler/global/initial.ml

@@ -35,6 +35,7 @@ let mk_static_bool b =
 
 
 (* build the initial environment *)
-let initialize () =
+let initialize modname =
+  Modules.initialize modname;
   List.iter (fun (f, ty) -> Modules.add_type f ty) tglobal;
   List.iter (fun (f, ty) -> Modules.add_constrs f ty) cglobal

compiler/global/modules.ml

@@ -11,6 +11,7 @@
 
 
 open Misc
+open Compiler_options
 open Signature
 open Types
 open Names
@@ -91,7 +92,7 @@ let _load_module modname =
   else
     let name = String.uncapitalize modname in
     try
-      let filename = Misc.findfile (name ^ ".epci") in
+      let filename = Compiler_utils.findfile (name ^ ".epci") in
       let ic = open_in_bin filename in
       let mo:module_object =
         try
@@ -101,18 +102,18 @@ let _load_module modname =
               close_in ic;
               Format.eprintf "Corrupted compiled interface file %s.@\n\
                               Please recompile %s.ept first.@." filename name;
-              raise Error in
+              raise Errors.Error in
       if mo.m_format_version <> interface_format_version
       then (
         Format.eprintf "The file %s was compiled with an older version \
                         of the compiler.@\nPlease recompile %s.ept first.@."
                        filename name;
-        raise Error );
+        raise Errors.Error );
       _append_module mo
     with
-      | Misc.Cannot_find_file(f) ->
+      | Compiler_utils.Cannot_find_file(f) ->
           Format.eprintf "Cannot find the compiled interface file %s.@." f;
-          raise Error
+          raise Errors.Error
 
 
 
@@ -286,5 +287,3 @@ let current_module () =
       m_fields = unqualify_all g_env.fields;
       m_format_version = g_env.format_version }
 
-
-

compiler/heptagon/analysis/causal.ml

@@ -90,7 +90,7 @@ let message loc kind =
           print_location loc
           output_ac ac
   end;
-  raise Misc.Error
+  raise Errors.Error
 
 let cor nc1 nc2 =
   match nc1, nc2 with

compiler/heptagon/analysis/initialization.ml

@@ -175,7 +175,7 @@ module Error = struct
             Printer.print_type left_ty
             Printer.print_type right_ty
     end;
-    raise Misc.Error
+    raise Errors.Error
 end
 
 let less_exp e actual_ty expected_ty =

compiler/heptagon/analysis/statefull.ml

@@ -9,7 +9,6 @@
 (* Checks that a node declared stateless is stateless *)
 open Names
 open Location
-open Misc
 open Signature
 open Modules
 open Heptagon
@@ -29,7 +28,7 @@ let message loc kind =
         Format.eprintf "%aThis expression should be stateless.@."
           print_location loc
   end;
-  raise Error
+  raise Errors.Error
 
 (** @returns whether the exp is statefull. Replaces node calls with
     the correct Efun or Enode depending on the node signature. *)

compiler/heptagon/analysis/typing.ml

@@ -158,7 +158,7 @@ let message loc kind =
           print_location loc
           print_type ty
   end;
-  raise Error
+  raise Errors.Error
 
 (** Add wrappers around Modules function to raise errors
     and display the correct location. *)

compiler/heptagon/hept_mapfold.ml

@@ -49,6 +49,7 @@
    provided in this file. Trespassers will loop infinitely! /!\ *)
 
 open Misc
+open Errors
 open Global_mapfold
 open Heptagon
 

compiler/heptagon/hept_printer.ml

@@ -54,7 +54,7 @@ let print_local_vars ff = function
   | l -> fprintf ff "@[<4>%a@]@\n" (print_list_r print_vd "var "";"";") l
 
 let print_const_dec ff c =
-  if !Misc.full_type_info then
+  if !Compiler_options.full_type_info then
     fprintf ff "const %a : %a = %a"
       print_qualname c.c_name print_type c.c_type print_static_exp c.c_value
   else
@@ -85,7 +85,7 @@ and print_exps ff e_list =
   print_list_r print_exp "(" "," ")" ff e_list
 
 and print_exp ff e =
- if !Misc.full_type_info then
+ if !Compiler_options.full_type_info then
     fprintf ff "(%a : %a)"
       print_exp_desc e.e_desc print_type e.e_ty
   else fprintf ff "%a" print_exp_desc e.e_desc

compiler/heptagon/main/hept_compiler.ml

@@ -7,8 +7,7 @@
 (*                                                                        *)
 (**************************************************************************)
 
-
-open Misc
+open Compiler_options
 open Compiler_utils
 open Location
 open Global_printer
@@ -86,7 +85,7 @@ let compile_interface modname filename =
     close_out itc in
 
   try
-    init_compiler modname;
+    Initial.initialize modname;
 
     (* Parsing of the file *)
     let l = do_silent_pass "Parsing" parse_interface lexbuf in

compiler/heptagon/main/heptcheck.ml

@@ -25,7 +25,7 @@ let check_implementation modname filename =
   in
 
   try
-    init_compiler modname;
+    Initial.initialize modname;
     add_include (Filename.dirname filename);
 
     (* Parsing of the file *)
@@ -59,7 +59,7 @@ let main () =
       (compile check_implementation)
       errmsg;
   with
-    | Misc.Error -> exit 2;;
+    | Errors.Error -> exit 2;;
 
 main ()
 

compiler/heptagon/parsing/hept_scoping.ml

@@ -74,7 +74,7 @@ struct
           eprintf "%aA static expression was expected.@."
             print_location loc
     end;
-    raise Misc.Error
+    raise Errors.Error
 
   exception ScopingError of error
 

compiler/heptagon/transformations/completion.ml

@@ -66,7 +66,7 @@ let eqdesc funs _ ed = match ed with
         Hept_mapfold.eqdesc funs_collect Env.empty ed in
       (* add missing defnames *)
       Hept_mapfold.eqdesc funs defnames ed
-  | _ -> raise Misc.Fallback
+  | _ -> raise Errors.Fallback
 
 let funs = { Hept_mapfold.defaults with eqdesc = eqdesc; block = block; }
 

compiler/heptagon/transformations/last.ml

@@ -30,7 +30,7 @@ let extend_env env v = List.fold_left last ([], env, []) v
 let edesc _ env ed = match ed with
   | Elast x ->
       let lx = Env.find x env in Evar lx, env
-  | _ -> raise Misc.Fallback
+  | _ -> raise Errors.Fallback
 
 let block funs env b =
   let eq_lastn_n_list, env, last_v = extend_env env b.b_local in

compiler/main/hept2mls.ml

@@ -37,7 +37,7 @@ struct
           eprintf "%aThis construct is not supported by MiniLS.@."
             print_location loc
     end;
-    raise Misc.Error
+    raise Errors.Error
 end
 
 module Env =

compiler/main/heptc.ml

@@ -12,6 +12,7 @@ open Misc
 open Modules
 open Location
 open Compiler_utils
+open Compiler_options
 open Hept_compiler
 
 
@@ -33,7 +34,7 @@ let compile_impl modname filename =
     close_out mlsc in
 
   try
-    init_compiler modname;
+    Initial.initialize modname;
     add_include (Filename.dirname filename);
 
     (* Parsing of the file *)
@@ -88,6 +89,6 @@ let main () =
       (compile compile_impl)
       errmsg;
   with
-    | Misc.Error -> exit 2;;
+    | Errors.Error -> exit 2;;
 
 main ()

compiler/minils/analysis/clocking.ml

@@ -28,7 +28,7 @@ let error_message loc = function
         print_location loc
         print_clock actual_ct
         print_clock expected_ct;
-      raise Error
+      raise Errors.Error
 
 
 let typ_of_name h x = Env.find x h
@@ -119,11 +119,11 @@ let typing_eqs h eq_list = (*TODO FIXME*)
   let typing_eq { eq_lhs = pat; eq_rhs = e } =
     let ty_pat = typing_pat h pat in
     (try expect h ty_pat e with
-      | Error -> (* DEBUG *)
+      | Errors.Error -> (* DEBUG *)
           Format.eprintf "Complete expression: %a@\nClock pattern: %a@."
             Mls_printer.print_exp e
             Mls_printer.print_clock ty_pat;
-          raise Error)
+          raise Errors.Error)
   in List.iter typing_eq eq_list
 
 let build h dec =

compiler/minils/analysis/init.ml

@@ -192,7 +192,7 @@ struct
               but is expected to have type %a@."
               print_location loc Printer.output_typ left_ty Printer.
               output_typ right_ty);
-     raise Misc.Error)
+     raise Errors.Error)
 
 end
 

compiler/minils/main/mls2seq.ml

@@ -8,6 +8,7 @@
 (**************************************************************************)
 
 open Compiler_utils
+open Compiler_options
 open Obc
 open Minils
 open Misc
@@ -45,11 +46,12 @@ let targets = [ "c", Obc_no_params Cmain.program;
 let generate_target p s =
   let print_unfolded p_list =
     comment "Unfolding";
-    if !Misc.verbose then List.iter (Mls_printer.print stderr) p_list in
+    if !Compiler_options.verbose then
+      List.iter (Mls_printer.print stderr) p_list in
 
   let target =
     (try List.assoc s targets
-    with Not_found -> language_error s; raise Error) in
+    with Not_found -> language_error s; raise Errors.Error) in
     match target with
       | Minils convert_fun ->
           convert_fun p
@@ -64,7 +66,7 @@ let generate_target p s =
           let o_list = List.map Mls2obc.program p_list in
           print_unfolded p_list;
           comment "Translation to Obc";
-          if !Misc.verbose then
+          if !verbose then
             List.iter (Obc_printer.print stdout) o_list;
           List.iter convert_fun o_list
 

compiler/minils/main/mls_compiler.ml

@@ -9,6 +9,7 @@
 open Misc
 open Location
 open Compiler_utils
+open Compiler_options
 
 let pp p = if !verbose then Mls_printer.print stdout p
 (*

compiler/minils/main/mlsc.ml

@@ -30,7 +30,7 @@ let compile_impl modname filename =
   in
 
   try
-    init_compiler modname;
+    Initial.initialize modname;
 
     (* Set pretty printer to the Minils one *)
     let pp = Mls_compiler.pp in
@@ -83,6 +83,6 @@ let main () =
       compile
       errmsg;
   with
-    | Misc.Error -> exit 2;;
+    | Errors.Error -> exit 2;;
 
 main ()

compiler/minils/mls_mapfold.ml

@@ -8,6 +8,7 @@
 (**************************************************************************)
 (* Generic mapred over Minils Ast *)
 open Misc
+open Errors
 open Global_mapfold
 open Minils
 

compiler/minils/mls_printer.ml

@@ -40,7 +40,7 @@ let rec print_clock ff = function
       fprintf ff "@[<2>(%a)@]" (print_list_r print_clock """ *""") ct_list
 
 let print_vd ff { v_ident = n; v_type = ty; v_clock = ck } =
-  if !Misc.full_type_info then
+  if !Compiler_options.full_type_info then
     fprintf ff "%a : %a :: %a" print_ident n print_type ty print_ck ck
   else fprintf ff "%a : %a" print_ident n print_type ty
 
@@ -49,7 +49,7 @@ let print_local_vars ff = function
   | l -> fprintf ff "@[<4>%a@]@\n" (print_list_r print_vd "var "";"";") l
 
 let print_const_dec ff c =
-  if !Misc.full_type_info then
+  if !Compiler_options.full_type_info then
     fprintf ff "const %a : %a = %a"
       print_qualname c.c_name print_type c.c_type print_static_exp c.c_value
   else
@@ -77,7 +77,7 @@ and print_dyn_index ff idx =
   fprintf ff "@[<2>%a@]" (print_list print_exp "[""][""]") idx
 
 and print_exp ff e =
-  if !Misc.full_type_info then
+  if !Compiler_options.full_type_info then
     fprintf ff "(%a : %a :: %a)"
       print_exp_desc e.e_desc print_type e.e_ty print_ck e.e_ck
   else fprintf ff "%a" print_exp_desc e.e_desc
@@ -164,7 +164,7 @@ and print_tag_e_list ff tag_e_list =
 
 
 and print_eq ff { eq_lhs = p; eq_rhs = e } =
-  if !Misc.full_type_info
+  if !Compiler_options.full_type_info
   then fprintf ff "@[<2>%a :: %a =@ %a@]"
     print_pat p  print_ck e.e_ck  print_exp e
   else fprintf ff "@[<2>%a =@ %a@]" print_pat p  print_exp e

compiler/minils/mls_utils.ml

@@ -18,7 +18,7 @@ let err_message ?(exp=void) ?(loc=exp.e_loc) = function
       Format.eprintf "%aThe expression %a should be a static_exp.@."
         print_location loc
         print_exp exp;
-      raise Error
+      raise Errors.Error
 
 let rec static_exp_of_exp e =
   match e.e_desc with

compiler/minils/transformations/callgraph.ml

@@ -27,7 +27,7 @@ struct
             print_location se.se_loc
             print_static_exp se
     end;
-    raise Misc.Error
+    raise Errors.Error
 end
 
 module Param_instances :
@@ -213,7 +213,7 @@ let load_object_file modname =
   Modules.open_module modname;
   let name = String.uncapitalize modname in
     try
-      let filename = Misc.findfile (name ^ ".epo") in
+      let filename = Compiler_utils.findfile (name ^ ".epo") in
       let ic = open_in_bin filename in
         try
           let p:program = input_value ic in
@@ -221,7 +221,7 @@ let load_object_file modname =
               Format.eprintf "The file %s was compiled with \
                        an older version of the compiler.@\n\
                        Please recompile %s.ept first.@." filename name;
-              raise Error
+              raise Errors.Error
             );
             close_in ic;
             info.opened <- NamesEnv.add p.p_modname p info.opened
@@ -230,12 +230,12 @@ let load_object_file modname =
               close_in ic;
               Format.eprintf "Corrupted object file %s.@\n\
                         Please recompile %s.ept first.@." filename name;
-              raise Error
+              raise Errors.Error
     with
-      | Misc.Cannot_find_file(filename) ->
+      | Compiler_utils.Cannot_find_file(filename) ->
           Format.eprintf "Cannot find the object file '%s'.@."
             filename;
-          raise Error
+          raise Errors.Error
 
 (** @return the node with name [ln], loading the corresponding
     object file if necessary. *)
@@ -265,7 +265,7 @@ let collect_node_calls ln =
     | Eiterator(_, { a_op = (Enode ln | Efun ln); a_params = params },
                 _, _, _) ->
         ed, add_called_node ln params acc
-    | _ -> raise Misc.Fallback
+    | _ -> raise Errors.Fallback
   in
   let funs = { Mls_mapfold.defaults with edesc = edesc } in
   let n = node_by_longname ln in

compiler/minils/transformations/itfusion.ml

@@ -119,7 +119,7 @@ let edesc funs acc ed =
             ed, acc
 
 
-    | _ -> raise Misc.Fallback
+    | _ -> raise Errors.Fallback
 
 
 let program p =

compiler/minils/transformations/schedule.ml

@@ -84,7 +84,7 @@ let edesc _ () = function
     let nd = { nd with n_equs = schedule nd.n_equs } in
       Itfusion.replace_anon_node f nd;
       Eiterator(it, app, n, e_list, r), ()
-  | _ -> raise Fallback
+  | _ -> raise Errors.Fallback
 
 let program p =
   let p, () = Mls_mapfold.program_it

compiler/obc/c/c.ml

@@ -291,7 +291,7 @@ let pp_cfile_desc fmt filen cfile =
   match cfile with
     | Cheader (deps, cdecls) ->
         let headern_macro = String.uppercase filen_wo_ext in
-        Misc.print_header_info fmt "/*" "*/";
+        Compiler_utils.print_header_info fmt "/*" "*/";
         fprintf fmt "#ifndef %s_H@\n" headern_macro;
         fprintf fmt "#define %s_H@\n@\n" headern_macro;
         iter (fun d -> fprintf fmt "#include \"%s.h\"@\n" d)
@@ -300,7 +300,7 @@ let pp_cfile_desc fmt filen cfile =
         fprintf fmt "#endif // %s_H@\n@?" headern_macro
     | Csource cdefs ->
         let headern = filen_wo_ext ^ ".h" in
-        Misc.print_header_info fmt "/*" "*/";
+        Compiler_utils.print_header_info fmt "/*" "*/";
         fprintf fmt "#include <stdio.h>@\n";
         fprintf fmt "#include <string.h>@\n";
         fprintf fmt "#include <stdlib.h>@\n";
@@ -313,7 +313,8 @@ let pp_cfile_desc fmt filen cfile =
 (** [output_cfile dir cfile] pretty-prints the content of [cfile] to the
     corresponding file in the [dir] directory. *)
 let output_cfile dir (filen, cfile_desc) =
-  if !Misc.verbose then Format.printf "C-NG generating %s/%s@." dir filen;
+  if !Compiler_options.verbose then
+    Format.printf "C-NG generating %s/%s@." dir filen;
   let buf = Buffer.create 20000 in
   let oc = open_out (Filename.concat dir filen) in
   let fmt = Format.formatter_of_buffer buf in

compiler/obc/c/cgen.ml

@@ -53,7 +53,7 @@ struct
                     reset are not supported (found '%s').@."
           print_location loc
           s);
-    raise Misc.Error
+    raise Errors.Error
 end
 
 let rec struct_name ty =

compiler/obc/c/cmain.ml

@@ -253,9 +253,10 @@ let main_skel var_list prologue body =
     }
   }
 
-let mk_main name p = match (!Misc.simulation_node, !Misc.assert_nodes) with
-  | (None, []) -> []
-  | (_, n_names) ->
+let mk_main name p =
+  match (!Compiler_options.simulation_node, !Compiler_options.assert_nodes) with
+    | (None, []) -> []
+    | (_, n_names) ->
       let find_class n =
         try List.find (fun cd -> cd.cd_name.name = n) p.p_defs
         with Not_found ->
@@ -271,7 +272,7 @@ let mk_main name p = match (!Misc.simulation_node, !Misc.assert_nodes) with
         List.fold_right add a_classes ([], [], []) in
 
       let (_, var_l, res_l, step_l) =
-        (match !Misc.simulation_node with
+        (match !Compiler_options.simulation_node with
            | None -> (n_names, var_l, res_l, step_l)
            | Some n ->
                let (nvar_l, res, nstep_l) =

compiler/obc/obc_mapfold.ml

@@ -8,6 +8,7 @@
 (**************************************************************************)
 (* Generic mapred over Obc Ast *)
 open Misc
+open Errors
 open Global_mapfold
 open Obc
 

compiler/obc/obc_utils.ml

@@ -28,13 +28,13 @@ struct
         let add deps (ln, _) = deps_longname deps ln in
         (sedesc, List.fold_left add deps fnel)
       | Sop (ln, _) -> (sedesc, deps_longname deps ln)
-      | _ -> raise Fallback
+      | _ -> raise Errors.Fallback
 
   let deps_lhsdesc funs deps ldesc =
     let (ldesc, deps) = Obc_mapfold.lhsdesc funs deps ldesc in
     match ldesc with
       | Lfield (_, ln) -> (ldesc, deps_longname deps ln)
-      | _ -> raise Fallback
+      | _ -> raise Errors.Fallback
 
   let deps_edesc funs deps edesc =
     let (edesc, deps) = Obc_mapfold.edesc funs deps edesc in
@@ -43,7 +43,7 @@ struct
       | Estruct (ln, fnel) ->
         let add deps (ln, _) = deps_longname deps ln in
         (edesc, List.fold_left add (deps_longname deps ln) fnel)
-      | _ -> raise Fallback
+      | _ -> raise Errors.Fallback
 
   let deps_act funs deps act =
     let (act, deps) = Obc_mapfold.act funs deps act in
@@ -51,7 +51,7 @@ struct
       | Acase (_, cbl) ->
         let add deps (ln, _) = deps_longname deps ln in
         (act, List.fold_left add deps cbl)
-      | _ -> raise Fallback
+      | _ -> raise Errors.Fallback
 
   let deps_obj_dec funs deps od =
     let (od, deps) = Obc_mapfold.obj_dec funs deps od in
@@ -68,4 +68,4 @@ struct
     } in
     let (_, deps) = Obc_mapfold.program funs S.empty p in
     S.remove p.p_modname (S.remove "Pervasives" deps)
-end
+end

compiler/utilities/global/compiler_options.ml

@@ -0,0 +1,83 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Heptagon                                                              *)
+(*                                                                        *)
+(*  Author : Marc Pouzet                                                  *)
+(*  Organization : Demons, LRI, University of Paris-Sud, Orsay            *)
+(*                                                                        *)
+(**************************************************************************)
+(* Compiler options *)
+
+(* version of the compiler *)
+let version = "0.4"
+let date = "DATE"
+
+(* standard module *)
+let pervasives_module = "Pervasives"
+let standard_lib = "STDLIB"
+let standard_lib = try Sys.getenv "HEPTLIB" with Not_found -> standard_lib
+
+(* list of modules initially opened *)
+let default_used_modules = ref [pervasives_module]
+let set_no_pervasives () = default_used_modules := []
+
+(* load paths *)
+let load_path = ref ([standard_lib])
+
+
+let set_stdlib p =
+  load_path := [p]
+and add_include d =
+  load_path := d :: !load_path;;
+
+(* where is the standard library *)
+let locate_stdlib () =
+  let stdlib = try
+    Sys.getenv "HEPTLIB"
+  with
+      Not_found -> standard_lib in
+  Format.printf "Standard library in %s@." stdlib
+
+let show_version () =
+  Format.printf "The Heptagon compiler, version %s (%s)@."
+    version date;
+  locate_stdlib ()
+
+
+(* other options of the compiler *)
+let verbose = ref false
+let print_types = ref false
+
+let assert_nodes:string list ref = ref []
+let add_assert nd = assert_nodes := nd :: !assert_nodes
+
+let simulation = ref false
+let simulation_node : string option ref = ref None
+let set_simulation_node s =
+  simulation := true;
+  simulation_node := Some s
+
+let create_object_file = ref false
+
+(* Target languages list for code generation *)
+let target_languages : string list ref = ref []
+
+let add_target_language s =
+  target_languages := s :: !target_languages
+
+(* Optional path for generated files (C or Java) *)
+let target_path : string option ref = ref None
+
+let set_target_path path =
+  target_path := Some path
+
+let full_type_info = ref false
+
+let init = ref true
+
+let inline:string list ref = ref []
+let add_inlined_node s = inline := s :: !inline
+
+let flatten = ref false
+
+let nodes_to_inline : string list ref = ref []

compiler/utilities/global/compiler_utils.ml

@@ -6,9 +6,10 @@
 (*  Organization : Demons, LRI, University of Paris-Sud, Orsay            *)
 (*                                                                        *)
 (**************************************************************************)
-open Misc
 open Location
-open Minils
+open Format
+open Unix
+open Compiler_options
 
 type lexical_error =
   | Illegal_character
@@ -23,11 +24,11 @@ let lexical_error err loc =
     | Bad_char_constant -> "%aBad char constant.@."
     | Unterminated_string -> "%aUnterminated string.@."
      ) print_location loc;
-  raise Error
+  raise Errors.Error
 
 let syntax_error loc =
   Format.eprintf "%aSyntax error.@." print_location loc;
-  raise Error
+  raise Errors.Error
 
 let language_error lang =
   Format.eprintf "Unknown language: '%s'.@." lang
@@ -73,9 +74,20 @@ let clean_dir dir =
   end else Unix.mkdir dir 0o740;
   dir
 
-let init_compiler modname =
-  Modules.initialize modname;
-  Initial.initialize ()
+exception Cannot_find_file of string
+
+let findfile filename =
+  if Sys.file_exists filename then
+    filename
+  else if not(Filename.is_implicit filename) then
+    raise(Cannot_find_file filename)
+  else
+    let rec find = function
+      | [] -> raise(Cannot_find_file filename)
+      | a::rest ->
+          let b = Filename.concat a filename in
+          if Sys.file_exists b then b else find rest in
+    find !load_path
 
 let lexbuf_from_file file_name =
   let ic = open_in file_name in
@@ -84,6 +96,18 @@ let lexbuf_from_file file_name =
       { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = file_name };
   ic, lexbuf
 
+let print_header_info ff cbeg cend =
+  let tm = Unix.localtime (Unix.time ()) in
+  fprintf ff "%s --- Generated the %d/%d/%d at %d:%d --- %s@\n"
+    cbeg tm.tm_mday (tm.tm_mon+1) (tm.tm_year + 1900) tm.tm_hour tm.tm_min cend;
+  fprintf ff "%s --- heptagon compiler, version %s (compiled %s) --- %s@\n"
+    cbeg version date cend;
+  fprintf ff "%s --- Command line: %a--- %s@\n@\n"
+    cbeg
+    (fun ff a ->
+       Array.iter (fun arg -> fprintf ff "%s " arg) a)
+    Sys.argv
+    cend
 
 
 let doc_verbose = "\t\t\tSet verbose mode"

compiler/utilities/global/errors.ml

@@ -0,0 +1,13 @@
+(**************************************************************************)
+(*                                                                        *)
+(*  Heptagon                                                              *)
+(*                                                                        *)
+(*  Author : Marc Pouzet                                                  *)
+(*  Organization : Demons, LRI, University of Paris-Sud, Orsay            *)
+(*                                                                        *)
+(**************************************************************************)
+
+(* error during the whole process *)
+exception Error
+(** Ast iterators *)
+exception Fallback

compiler/utilities/misc.ml

@@ -8,102 +8,6 @@
 (**************************************************************************)
 (* useful stuff *)
 
-(* version of the compiler *)
-let version = "0.4"
-let date = "DATE"
-
-(* standard module *)
-let pervasives_module = "Pervasives"
-let standard_lib = "STDLIB"
-let standard_lib = try Sys.getenv "HEPTLIB" with Not_found -> standard_lib
-
-(* list of modules initially opened *)
-let default_used_modules = ref [pervasives_module]
-let set_no_pervasives () = default_used_modules := []
-
-(* load paths *)
-let load_path = ref ([standard_lib])
-
-let set_stdlib p =
-  load_path := [p]
-and add_include d =
-  load_path := d :: !load_path;;
-
-(* where is the standard library *)
-let locate_stdlib () =
-  let stdlib = try
-    Sys.getenv "HEPTLIB"
-  with
-      Not_found -> standard_lib in
-  Format.printf "Standard library in %s@." stdlib
-
-let show_version () =
-  Format.printf "The Heptagon compiler, version %s (%s)@."
-    version date;
-  locate_stdlib ()
-
-(* other options of the compiler *)
-let verbose = ref false
-let print_types = ref false
-
-let assert_nodes = ref []
-let add_assert nd = assert_nodes := nd :: !assert_nodes
-
-let simulation = ref false
-let simulation_node : string option ref = ref None
-let set_simulation_node s =
-  simulation := true;
-  simulation_node := Some s
-
-let create_object_file = ref false
-
-(* Target languages list for code generation *)
-let target_languages : string list ref = ref []
-
-let add_target_language s =
-  target_languages := s :: !target_languages
-
-(* Optional path for generated files (C or Java) *)
-let target_path : string option ref = ref None
-
-let set_target_path path =
-  target_path := Some path
-
-let full_type_info = ref false
-
-let boolean = ref false
-
-let deadcode = ref false
-
-let init = ref true
-
-let cse = ref false
-
-let tomato = ref false
-
-let inline = ref []
-
-let add_inlined_node s = inline := s :: !inline
-
-let flatten = ref false
-
-(* Backward compatibility *)
-let set_sigali () = add_target_language "z3z";;
-
-let intermediate = ref false
-
-let nodes_to_inline : string list ref = ref []
-
-let nodes_to_display : string list ref = ref []
-
-let node_to_flatten : string option ref = ref None
-
-let no_mem_alloc = ref false
-
-let use_interf_scheduler = ref false
-
-let use_new_reset_encoding = ref false
-
 let optional f = function
   | None -> None
   | Some x -> Some (f x)
@@ -125,8 +29,6 @@ let rec split_string s c =
     String.sub s 0 id :: split_string rest c
   with Not_found -> [s]
 
-(* error during the whole process *)
-exception Error
 
 (* creation of names. Ensure unicity for the whole compilation chain *)
 let symbol = ref 0
@@ -134,22 +36,6 @@ let symbol = ref 0
 let gen_symbol () = incr symbol; "_"^(string_of_int !symbol)
 let reset_symbol () = symbol := (*!min_symbol*) 0
 
-open Format
-open Unix
-
-let print_header_info ff cbeg cend =
-  let tm = Unix.localtime (Unix.time ()) in
-  fprintf ff "%s --- Generated the %d/%d/%d at %d:%d --- %s@\n"
-    cbeg tm.tm_mday (tm.tm_mon+1) (tm.tm_year + 1900) tm.tm_hour tm.tm_min cend;
-  fprintf ff "%s --- heptagon compiler, version %s (compiled %s) --- %s@\n"
-    cbeg version date cend;
-  fprintf ff "%s --- Command line: %a--- %s@\n@\n"
-    cbeg
-    (fun ff a ->
-       Array.iter (fun arg -> fprintf ff "%s " arg) a)
-    Sys.argv
-    cend
-
 let unique l =
   let tbl = Hashtbl.create (List.length l) in
   List.iter (fun i -> Hashtbl.replace tbl i ()) l;
@@ -217,7 +103,6 @@ let rec assocd value = function
 
 
 (** { 3 Compiler iterators } *)
-exception Fallback
 
 (** Mapfold *)
 let mapfold f acc l =
@@ -293,18 +178,3 @@ let assert_2min = function
 let assert_3 = function
   | [v1; v2; v3] -> v1, v2, v3
   | l -> _arity_error 3 l
-
-exception Cannot_find_file of string
-
-let findfile filename =
-  if Sys.file_exists filename then
-    filename
-  else if not(Filename.is_implicit filename) then
-    raise(Cannot_find_file filename)
-  else
-    let rec find = function
-      | [] -> raise(Cannot_find_file filename)
-      | a::rest ->
-          let b = Filename.concat a filename in
-          if Sys.file_exists b then b else find rest in
-    find !load_path

compiler/utilities/misc.mli

@@ -7,113 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-
-(* Version and date of compilation *)
-val version : string
-val date : string
-
-(* List of modules initially opened *)
-val default_used_modules : string list ref
-
-(* Void the list of modules initially opened *)
-val set_no_pervasives : unit -> unit
-
-(* Path list to libraries *)
-val load_path : string list ref
-
-(* Set path to standard library *)
-val set_stdlib : string -> unit
-
-(* Add path to libraries *)
-val add_include : string -> unit
-
-(* Print the path to standard library *)
-val locate_stdlib : unit -> unit
-
-(* Print the compiler version and its compilation date *)
-val show_version : unit -> unit
-
-(* Verbose option *)
-val verbose : bool ref
-
-(* Print types option *)
-val print_types : bool ref
-
-(* Nodes to check at run-time *)
-val assert_nodes : string list ref
-
-(* Add node (name) to the list of nodes to be checked. *)
-val add_assert : string -> unit
-
-(* Simulation mode *)
-val simulation : bool ref
-(* Simulated node *)
-val simulation_node : string option ref
-(* Set the simulation mode on *)
-val set_simulation_node : string -> unit
-
-(* If it is true, the compiler will only generate an object file (.epo).
-   Otherwise, it will generate obc code and possibily other targets.*)
-val create_object_file : bool ref
-(* List of target languages *)
-val target_languages : string list ref
-(* Add target language to the list *)
-val add_target_language : string -> unit
-
-(* Optional path for generated files (C or Java) *)
-val target_path : string option ref
-(* Set the optional target path *)
-val set_target_path : string -> unit
-
-(* Print full type information when pretty-printing MiniLS code. *)
-val full_type_info : bool ref
-
-(* Boolean transformation of enumerated types *)
-val boolean : bool ref
-
-(* Deadcode removal *)
-val deadcode : bool ref
-
-(* Initialization analysis (enabled by default) *)
-val init : bool ref
-
-(* Common sub-expression elimination *)
-val cse : bool ref
-
-(* Automata minimization *)
-val tomato : bool ref
-
-(* List of nodes to inline *)
-val inline : string list ref
-(* Add a new node name to the list of nodes to inline. *)
-val add_inlined_node : string -> unit
-(* Inline every node. *)
-val flatten : bool ref
-
-(* Z/3Z back-end mode *)
-val set_sigali : unit -> unit
-
-(* Intermediate-equations removal *)
-val intermediate : bool ref
-
-(* Nodes to be inlined *)
-val nodes_to_inline : string list ref
-
-(* Nodes which dependency graphics will be serialized to .dot file. *)
-val nodes_to_display : string list ref
-
-(* Node to flatten *)
-val node_to_flatten : string option ref
-
-(* Disable the memory allocation phase*)
-val no_mem_alloc : bool ref
-
-(* Whether to use the interference aware scheduler*)
-val use_interf_scheduler : bool ref
-
-(* Use the new encoding of resets using reset_mem. *)
-val use_new_reset_encoding : bool ref
-
 (* Misc. functions *)
 val optional : ('a -> 'b) -> 'a option -> 'b option
 (** Optional with accumulator *)
@@ -121,15 +14,6 @@ val optional_wacc : ('a -> 'b -> 'c*'a) -> 'a -> 'b option -> ('c option * 'a)
 val optunit : ('a -> unit) -> 'a option -> unit
 val split_string : string -> char -> string list
 
-(* Printing header informations (compiler version, generation date...) *)
-(* [print_header_info ff cbeg cend] prints header info, where [ff] is
-   the formatter used, [cbeg] and [cend] the string of begin and end
-   of commentaries in the target language *)
-val print_header_info : Format.formatter -> string -> string -> unit
-
-(* Error during the whole process *)
-exception Error
-
 (* Generation of unique names. Mandatory call of reset_symbol between
    set_min_symbol and gen_symbol *)
 (*val set_min_symbol : int -> unit*)
@@ -169,12 +53,6 @@ val assocd : 'b -> ('a * 'b) list -> 'a
     induced by [c] *)
 val make_list_compare : ('a -> 'a -> int) -> 'a list -> 'a list -> int
 
-
-
-(** Ast iterators *)
-exception Fallback
-
-
 (** Mapfold *)
 val mapfold: ('a -> 'b -> 'c * 'a) -> 'a -> 'b list -> 'c list * 'a
 
@@ -196,5 +74,3 @@ val assert_2 : 'a list -> 'a * 'a
 val assert_2min : 'a list -> 'a * 'a * 'a list
 val assert_3 : 'a list -> 'a * 'a * 'a
 
-exception Cannot_find_file of string
-val findfile : string -> string