///////////////////////////////////////////////////////////////////////////////
//                             Lisaac Compiler                               //
//                                                                           //
//                   LSIIT - ULP - CNRS - INRIA - FRANCE                     //
//                                                                           //
//   This program is free software: you can redistribute it and/or modify    //
//   it under the terms of the GNU General Public License as published by    //
//   the Free Software Foundation, either version 3 of the License, or       //
//   (at your option) any later version.                                     //
//                                                                           //
//   This program is distributed in the hope that it will be useful,         //
//   but WITHOUT ANY WARRANTY; without even the implied warranty of          //
//   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the           //
//   GNU General Public License for more details.                            //
//                                                                           //
//   You should have received a copy of the GNU General Public License       //
//   along with this program.  If not, see <http://www.gnu.org/licenses/>.   //
//                                                                           //
//                     http://isaacproject.u-strasbg.fr/                     //
///////////////////////////////////////////////////////////////////////////////
Section Header
  
  + name      := LISAAC;

  - copyright := "2003-2007 Benoit Sonntag";
  
  - author   := "Sonntag Benoit (sonntag@icps.u-strasbg.fr)";
  - comment  := "The main prototype";
  
  - external := `#include "path.h"`;
  
  // Top 5 memory record :
  // 1 - LOCAL         (>20MB)
  // 2 - READ_LOCAL    (15MB)
  // 3 - LIST          (13MB)
  // 4 - PROTOTYPE_CST (10MB)
  // 5 - WRITE_LOCAL   (10MB)
  
Section Inherit
  
  - parent_any:ANY := ANY;
  
Section Private

  - output_name_exe : STRING_CONSTANT;
  
  - output_name_c : STRING_CONSTANT;
  
  - input_name  : STRING_CONSTANT;

  - target      : STRING_CONSTANT;

  //
  // Command.
  //

  - usage: STRING_CONSTANT :=
  "----------------------------------------------------------------\n\
  \--            Lisaac IS An Advanced Compiler V.0.13.1         --\n\
  \--            LORIA - LSIIT - ULP - CNRS - FRANCE             --\n\
  \--         Benoit SONNTAG - sonntag@icps.u-strasbg.fr         --\n\
  \--                   http://www.IsaacOS.com                   --\n\
  \----------------------------------------------------------------\n\
  \Usage:                                                          \n\
  \  lisaac <input_file[.li]> [Options]                            \n\
  \                                                                \n\
  \Options:                                                        \n\
  \  -o <output_file>    : output file (default:`input_file.c').   \n\
  \  -t <machine>        : target code (see path.li).              \n\
  \  -s                  : statistic information.                  \n\
  \  -[d|D]([+|-]|[1-20]): debug mode (default: `debug_level' = 0) \n\
  \                        `d'   : Without source code.            \n\
  \                        `D'   : With source code.               \n\
  \                        [d|D]-: `debug_level' = 5               \n\
  \                                (Require library only)          \n\
  \                        [d|D] : `debug_level' = 10              \n\
  \                                (Append user assertion)         \n\
  \                        [d|D]+: `debug_level' = 15              \n\
  \                                (Append Ensure library)         \n\
  \                        [d|D]n: `debug_level' = n (with 0<n<21) \n\
  \  -w                  : warning error stop compiler.            \n\
  \  -W                  : all warning (deferred detect, ...)      \n\
  \  -O                  : full optimization.                      \n\
  \  -i[1-5000]          : inlining level (default : 15)           \n\ 
  \  -q                  : quiet operation.                        \n\
  \                                                                \n\
  \Bug report:                                                     \n\
  \            post in : https://gna.org/bugs/?group=isaac         \n\
  \            mail to : sonntag@icps.u-strasbg.fr                 \n";

  - display_usage <-
  (
    usage.print;
    die_with_code exit_failure_code;
  );
  
  //
  // Options.
  //
  
  - read_options <-
  ( + cmd:STRING;
    + j,i:INTEGER;  
    + car:CHARACTER;
    + stat:INTEGER;

    // Default value.
    is_ansi := TRUE;
    // Read argument.
    j := 1;
    {j > COMMAND_LINE.upper}.until_do {
      cmd := COMMAND_LINE.item j;
      (cmd.item 1='-').if {
	//
	// Lecture des options :
	//
	(cmd.item 2 = 'v').if {
	  // Verbose mode 
	  verbose_level := 1;
	  (cmd.count > 2).if {
	    ((! cmd.item 3.is_digit) || {cmd.count > 3}).if {
	      display_usage;
	    };
	    verbose_level := cmd.item 3.decimal_value;
	  };
	}.elseif {cmd.item 2 = 's'} then {
	  // Statistic info
	  is_statistic := TRUE;
	}.elseif {cmd.item 2 = 'q'} then {
	  // Quiet operation.
	  is_quiet_operation := TRUE;
	}.elseif {cmd.item 2 = 'i'} then {
	  // Inline level
	  (cmd.upper = 2).if {
	    "Incorrect inline level.\n".print;
	    display_usage;
	  };
	  stat := 0;
	  i := 3;
	  {i <= cmd.upper}.while_do {
	    car := cmd.item i;
	    (car.is_digit).if {
	      stat := stat * 10 + car.decimal_value;
	    } else {
	      "Incorrect inline level.\n".print;
	      display_usage;
	    };
	    i := i + 1;
	  };
	  (! stat.in_range 1 to 5_000).if {
	    "Incorrect inline level.\n".print;
	    display_usage;
	  };
	  inline_level := stat + 2; 
	}.elseif {cmd.item 2.to_lower = 'd'} then {
	  // Debug mode.
	  (cmd.item 2 = 'D').if {
	    debug_with_code := TRUE;
	  };
	  debug_level_option := 10;	  
	  stat := 0;
	  i := 3;
	  {i <= cmd.upper}.while_do {
	    car := cmd.item i;
	    stat
	    .when 0 then {	      
	      (car = '-').if {
		debug_level_option := 5;
		stat := 2;
	      }.elseif {car = '+'} then {
		debug_level_option := 15;
		stat := 2;
	      }.elseif {car.is_digit} then {
		debug_level_option := car.decimal_value;
		stat := 1;
	      } else {
		display_usage;
	      };
	    }
	    .when 1 then {
	      (car.is_digit).if {
		debug_level_option := debug_level_option * 10 + car.decimal_value;
		(debug_level_option > 20).if {
		  display_usage;
		};
		stat := 2;
	      } else {
		display_usage;
	      };
	    }
	    .when 2 then {
	      display_usage;
	    };
	    i := i + 1;
	  };	  
	}.elseif {cmd.item 2 = 'o'} then {
	  // Output name.
	  j := j+1;
	  (j > COMMAND_LINE.upper).if {
	    display_usage;
	  };
	  string_tmp.copy (COMMAND_LINE.item j);
	  i := last_index (string_tmp,'.');
	  (i > string_tmp.lower).if {
	    string_tmp.remove_last (string_tmp.upper-i+1);
	  };
	  output_name_exe := ALIAS_STR.get string_tmp;
	}.elseif {cmd.item 2 = 't'} then {
	  // Target
	  j := j+1;
	  (j > COMMAND_LINE.upper).if {
	    display_usage;
	  };
	  string_tmp.copy (COMMAND_LINE.item j);
	  string_tmp.to_upper;
	  target := ALIAS_STR.get string_tmp;
	}.elseif {cmd.item 2 = 'w'} then {
	  // Warning option.
	  is_warning := TRUE;
	}.elseif {cmd.item 2 = 'W'} then {
	  // All Warning option.
	  is_all_warning := TRUE;
	}.elseif {cmd.item 2 = 'O'} then {
	  // Optimization
	  is_optimization := TRUE;
	  //"Warning: `-O' option is not yet implemented.\n".print;
	} else {
	  display_usage;
	};
      } else {
	//
	// Input name & Current Directory.
	//
	(input_name != NULL).if {
	  display_usage;
	};
	string_tmp.copy (COMMAND_LINE.item j);
	string_tmp2.copy string_tmp;
	string_tmp.replace_all '\\' with '/';
	i := last_index (string_tmp,'/');
	(i < string_tmp.lower).if {
	  string_tmp.copy "./";
	} else {
	  string_tmp.remove_last (string_tmp.upper-i);
	  string_tmp2.remove_first i;
	};
	i := last_index (string_tmp2,'.');
	(i > string_tmp2.lower).if {
	  string_tmp2.remove_last (string_tmp2.upper-i+1);
	};
	path_directory.add_last (ALIAS_STR.get string_tmp);
	string_tmp2.to_upper;
	input_name := ALIAS_STR.get string_tmp2;
      };
      j := j+1;
    };

    (input_name = NULL).if {
      display_usage;
    };
    ((debug_level_option != 0) && {is_optimization}).if {
      "Warning: `-O' option is not activated with a debug mode.\n".print;
      is_optimization := FALSE;
    };

    string_tmp.copy (path_directory.first);
    string_tmp.append input_name;
    string_tmp.append ".c";
    string_tmp.to_lower;
    output_name_c := ALIAS_STR.get string_tmp;
    (output_name_exe = NULL).if {      
      string_tmp.copy (path_directory.first);
      string_tmp.append input_name;
      string_tmp.to_lower;
      output_name_exe := ALIAS_STR.get string_tmp;
    };
    
    // Init path directory :
    load_directory;
  );
  
  - last_index (n:STRING,c:CHARACTER) :INTEGER <-
  // BSBS: A Mettre dans STRING.
  ( + result:INTEGER;
    result := n.upper;
    {(result < n.lower) || {n.item result = c}}.until_do {
      result := result-1;
    };
    result
  );

  - load_directory <-
  ( + var_lisaac:STRING_CONSTANT;
    + path:NATIVE_ARRAY[CHARACTER];
    (target=NULL).if {
      target := ALIAS_STR.section_default;
    };
    path := `LISAAC_DIRECTORY`:NATIVE_ARRAY[CHARACTER];
    var_lisaac := STRING_CONSTANT.new_intern path
    count (path.fast_first_index_of '\0' until 1024);
    //var_lisaac := ENVIRONMENT.get_environment_variable "LISAAC";
    //(var_lisaac = NULL).if {
    //  STD_ERROR.put_string "Unable to find `LISAAC' environment variable.\n";
    //  STD_ERROR.put_string "Please, set the environment variable `LISAAC'\n";
    //  STD_ERROR.put_string "with the appropriate absolute path to lisaac root directory.\n";
    //  STD_ERROR.put_string "Example: 'set LISAAC=/lisaac/'\n";
    //  die_with_code exit_failure_code;
    //};
    //
    string_tmp.copy var_lisaac;
    ((var_lisaac.last != '/') &&
    {var_lisaac.last != '\\'}).if {
      string_tmp.add_last '/';
    };
    PARSER.read_path_directory (ALIAS_STR.get string_tmp) target target 
    input output_name_c output output_name_exe;
  );

  - put_trace_code buf:STRING <-
  ( + proto:PROTOTYPE;
    
    title "DEBUG MANAGER" in buf;
    
    buf.append 
    "void print_string(char *str) \n\
    \{ \n\
    \  while (*str!=0) {\n\
    \    print_char(*str); \n\
    \    str++; \n\
    \  };\n\
    \}  \n\
    \\n";

    (debug_level_option != 0).if {
      buf.append "char *trace[";
      buf.append (PROTOTYPE.prototype_list.count.to_string);
      buf.append "]={\n";
      (PROTOTYPE.prototype_list.lower).to (PROTOTYPE.prototype_list.upper-1) do { 
	j:INTEGER;
	proto := PROTOTYPE.prototype_list.item j;
	buf.append "  \"";
	buf.append (proto.name);
	buf.append " (";
	buf.append (proto.filename);
	buf.append ")\",\n";
      };
      proto := PROTOTYPE.prototype_list.last;
      buf.append "  \"";
      buf.append (proto.name);
      buf.append " (";
      buf.append (proto.filename);
      buf.append ")\"\n};\n\n";

      //
      // Source Code.
      //
            
      (debug_with_code).if {
	+ src:HASHED_DICTIONARY[STRING,UINTEGER_32];
	+ key:UINTEGER_32;
	
	output_decl.append 
	"\n//==========================//\n\
	\// SOURCE LINE REFERENCE    //\n\
	\//==========================//\n";
	
	buf.append 
	"struct __source {\n\
	\  unsigned int pos;\n\
	\  char *line;\n\
	\} __src[";
	src := PUSH.source_line;
	src.count.append_in buf;
	buf.append "]={\n";		
	(src.lower).to (src.upper) do { j:INTEGER;
	  key := src.key j;
	  output_decl.append "#define L";
	  key.append_in output_decl;
	  output_decl.add_last ' ';
	  (j-1).append_in output_decl;
	  output_decl.add_last '\n';
	  //
	  buf.append "  {";	 
	  key.append_in buf;
	  buf.append ",\"";
	  buf.append (src.item j);
	  buf.append "\"},\n";
	};
	buf.remove (buf.upper - 1);
	buf.append "};\n\n";
      };
      
      //
      // Signal manager.
      // 
      
      (is_ansi).if {
	buf.append 
	"// Unix Signal manager:\n\
	\void interrupt_signal(int sig)  \n\
	\{                               \n\
	\  stack_print(top_context);     \n\
	\  print_string(\"User interrupt.\\n\"); \n\
	\  die_with_code(1);                     \n\
	\}                                       \n\n";
      };
	
      //
      // Stack manager.
      //
      
      buf.append 	
      "void push_first(_____CONTEXT *path,unsigned long code)\n\
      \{ \n";
      (debug_level_option = 20).if {
	buf.append 
	"  _____CONTEXT *cur,loop;\n\
	\  cur = top_context; \n\
	\  while ((cur != (void *)0) && (cur != path)) cur = cur->back; \n\
	\  if (cur == path) {\n\
	\    loop.back = top_context;\n\	
	\    loop.code = code; \n\
	\    stack_print(&loop);\n\
	\    print_string(\"COMPILER : Debug context looping detected !\\n\");\n\
	\    die_with_code(1);\n\
	\  };\n";
      };
      buf.append
      "  path->back  = top_context;\n\
      \  path->code  = code;\n\
      \  top_context = path;\n\
      \} \n\
      \  \n\
      \void push(_____CONTEXT *path,unsigned long code)\n\
      \{ \n\      	
      \  path->code  = code;\n\
      \  top_context = path;\n\  
      \} \n\
      \  \n\
      \void stack_print(_____CONTEXT *up)      \n\
      \{ _____CONTEXT *back,*next;             \n\
      \  int j;	                              \n\
      \  next = (void *)0;                          \n\  
      \  while (up != (void *)0) {                  \n\
      \    back = up -> back;                       \n\
      \    up -> back = next;                       \n\  
      \    next = up;                               \n\
      \    up = back;                               \n\
      \  };                                         \n\
      \  print_string(\"\\n============== BOTTOM ==============\\n\"); \n\
      \  while (next != (void *)0) {                \n";
      (debug_with_code).if {
	buf.append
	"    print_string(\"Line #\");                           \n\
	\    print_integer(__src[next->code].pos >> 17);         \n\ 
	\    print_string(\" Column #\");                        \n\
	\    print_integer((__src[next->code].pos >> 9) & 0xFF); \n\ 
	\    print_string(\" in \");                             \n\
	\    print_string(trace[__src[next->code].pos & 0x1FF]); \n\
	\    print_string(\".\\n\");                             \n\
\ if ((__src[next->code].pos & 0x1FF) != 0) { \n\
        \    print_string(__src[next->code].line);               \n\
	\    print_char('\\n');                                  \n\
	\    for (j=0;j < ((__src[next->code].pos >> 9) & 0xFF);j++) {\n\
	\      if (__src[next->code].line[j]=='\\t') print_char('\\t');\n\
        \      else print_char(' ');\n\
        \    };                                                  \n\
        \    print_char('^');    \n\
	\    print_char('\\n');   \n\
\ }; \n";	
	
      } else {    
	buf.append
	"    print_string(\"Line #\");                \n\
	\    print_integer(next->code >> 17);         \n\
	\    print_string(\" Column #\");          \n\
	\    print_integer((next->code >> 9) & 0xFF); \n\ 
	\    print_string(\" in \");               \n\
	\    print_string(trace[next->code & 0x1FF]); \n\
	\    print_string(\".\\n\");                  \n";
      };
      buf.append 
      "    next = next -> back;                     \n\
      \  };                                         \n\
      \  print_string(\"================ TOP ===============\\n\"); \n\
      \  top_context = (void *)0;                   \n\
      \}                                            \n\
      \ \n\
      \void print_integer(unsigned short n) \n\
      \{ unsigned short val;                \n\
      \  char car;                          \n\	
      \  car = (n % 10) + '0';              \n\
      \  val = n / 10;                      \n\
      \  if (val != 0) print_integer(val);  \n\
      \  print_char(car);                   \n\
      \} \n\n";
    };
  );
  
  - load_main_object <-
  ( + type_gen:FAST_ARRAY[ITM_TYPE_MONO];
    + itm_type_character:ITM_TYPE_MONO;
    + itm_type_n_a_character:ITM_TYPE_MONO;
    
    // NULL, VOID, CONTEXT
    TYPE_NULL.make_null;    
    TYPE_VOID.make_void;
    TYPE_CONTEXT.make_context;
    TYPE_ID.make_type_id; // Pas utile !    
    // Input.
    type_input   := ITM_TYPE_SIMPLE.get input_name.to_run.raw;
    // Other prototype.
    type_true    := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_true)      
    style (ALIAS_STR.keyword_expanded).to_run.raw;
    type_false   := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_false)     
    style (ALIAS_STR.keyword_expanded).to_run.raw;
    type_boolean := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_boolean)   
    style (ALIAS_STR.keyword_expanded).to_run.raw;
    type_integer := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_integer)   
    style (ALIAS_STR.keyword_expanded).to_run.raw;
    type_real    := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_real)   
    style (ALIAS_STR.keyword_expanded).to_run.raw;
    type_integer_32 := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_integer_32)   
    style (ALIAS_STR.keyword_expanded).to_run.raw;
    type_string_constant := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_string_constant).to_run.raw;
    itm_type_character   := ITM_TYPE_STYLE.get (ALIAS_STR.prototype_character) 
    style (ALIAS_STR.keyword_expanded);
    type_character := itm_type_character.to_run.raw;
    type_block     := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_block).to_run.raw;        
    //
    type_pointer   := ITM_TYPE_SIMPLE.get (ALIAS_STR.prototype_pointer).to_run.raw;
    // NATIVE_ARRAY[CHARACTER]
    type_gen  := ALIAS_ARRAY[ITM_TYPE_MONO].new;
    type_gen.add_last itm_type_character;
    type_gen  := ALIAS_ARRAY[ITM_TYPE_MONO].alias type_gen;
    itm_type_n_a_character := ITM_TYPE_GENERIC.get (ALIAS_STR.prototype_native_array)
    style NULL with type_gen;
    type_n_a_character := itm_type_n_a_character.to_run.raw;
    // NATIVE_ARRAY[NATIVE_ARRAY[CHARACTER]]
    type_gen  := ALIAS_ARRAY[ITM_TYPE_MONO].new;
    type_gen.add_last itm_type_n_a_character;
    type_gen  := ALIAS_ARRAY[ITM_TYPE_MONO].alias type_gen;
    type_n_a_n_a_character := ITM_TYPE_GENERIC.get (ALIAS_STR.prototype_native_array)
    style NULL with type_gen.to_run.raw;
    //    
    ? {type_input != NULL};
  );
  
  - print msg:STRING_CONSTANT stat n:INTEGER for t:INTEGER <-
  ( + pour_mil:INTEGER;
    
    (t != 0).if {
      STD_ERROR.put_string msg;    
      pour_mil := `(int)((1000./ @t * @n))`:INTEGER;
      STD_ERROR.put_integer (pour_mil/10);
      STD_ERROR.put_character '.';
      STD_ERROR.put_integer (pour_mil%10);
      STD_ERROR.put_string "% (";
      STD_ERROR.put_integer n;
      STD_ERROR.put_character '/';
      STD_ERROR.put_integer t;
      STD_ERROR.put_string ")\n";
    };
  );
  
Section Public  

  //
  // Creation.
  //

  - main <-
  ( + file_output:POINTER;
    //+ entry:ENTRY;
    + begin_time,end_time:UINTEGER_64;
    + time:INTEGER;    
    + txt:STRING;

    ALIAS_STR.make;
    
    begin_time := SYSTEM.get_universal_time;
    
    //
    // Load Environment. 
    //
    read_options;
    is_verbose.if {
      string_tmp.copy "\ninput  file : ";
      string_tmp.append input_name;
      string_tmp.to_lower;
      string_tmp.append ".li\noutput file : ";
      string_tmp.append output_name_exe;
      string_tmp.append "\ntarget : ";
      string_tmp.append target;
      string_tmp.append "\npath directory :\n";
      path_directory.lower.to (path_directory.upper) do { j:INTEGER;
	string_tmp.append "  ";
	string_tmp.append (path_directory.item j);
	string_tmp.add_last '\n';
      };
      string_tmp.print;
    };
    
    //
    // Header C 
    //    
    output_decl.copy "// C code generated by Lisaac compiler (www.isaacOS.com) //\n";
    
    // ANSI argument command.
    (debug_level_option != 0).if {
      output_decl.append "#include <signal.h>\n";
    };
    output_decl.append 
    "int arg_count;\n\
    \char **arg_vector;\n";
    
    // External.
    title "EXTERNAL" in output_decl;

    //
    // Load prototype constant.
    //
    load_main_object;
    
    // Compilation.    
    type_input.prototype.depend;    
    
    // Type / Struct.
    title "TYPE" in output_decl;
                
    output_decl.append 
    "// Generic Object\n\
    \struct ___OBJ {\n\
    \  unsigned long __id;\n\
    \};\n\n";    
    
    title "GLOBAL" in output_glob;
        
    // Function header.
    title "FUNCTION HEADER" in output_code;
    
    // Debug source code.
    output_code.append "// Debug Manager\n"; 
    output_code.append "void print_string(char *str);\n";
    (debug_level_option != 0).if {      
      (is_ansi).if {
	output_code.append "void interrupt_signal(int sig);\n";
      };
      output_code.append 
      "void stack_print(_____CONTEXT *up);\n\
      \void push_first(_____CONTEXT *path,unsigned long code);\n\
      \void push(_____CONTEXT *path,unsigned long code);\n\
      \void print_integer(unsigned short n);\n";
    };
    
    // Extern source code.
    output_code.append "// Source code\n";
    PROFIL_LIST.genere_handler output_code;
    
    // Source code.
    title "SOURCE CODE" in output_code;        
    
    output_code.append "int main(int argc,char **argv)\n";
    list_main.genere_extern output_code;
    output_code.add_last '\n';
    
    PROFIL_LIST.genere output_code;
    
    TYPE.genere_all_struct;
    output_decl.append "\nvoid *table_type[";
    TYPE.id_counter_without_type.append_in output_decl;
    output_decl.append "];\n";
        
    // String Constant.

    // Trace code.    
    put_trace_code output_code;
    
    //
    // Saving File Output.
    //    
    (! FS_MIN.make_file output_name_c).if {
      STD_ERROR.put_string "Error: File ";
      STD_ERROR.put_string output_name_c;
      STD_ERROR.put_string " is not created !\n";
      die_with_code exit_failure_code;
    };

    file_output := FS_MIN.open_write output_name_c;
    FS_MIN.write file_output with output_decl size (output_decl.count);    
    FS_MIN.write file_output with output_glob size (output_glob.count);
    (STRING_CST.output_count != 0).if {
      txt := STRING_CST.output;
      FS_MIN.write file_output with txt size (txt.count);
    };    
    FS_MIN.write file_output with output_code size (output_code.count);
    FS_MIN.close file_output;
    //
    end_time := SYSTEM.get_universal_time;
    (is_quiet_operation).if_false {
      STD_ERROR.put_string " => ";
      time := (end_time - begin_time).to_integer;
      (time >= 120).if {
	STD_ERROR.put_integer (time/60);
	STD_ERROR.put_string " minutes, ";
	time := time % 60;
      };
      STD_ERROR.put_integer time;
      STD_ERROR.put_string " second(s).\n";
      //
      (POSITION.nb_warning != 0).if {
	STD_ERROR.put_string " => ";
	STD_ERROR.put_integer (POSITION.nb_warning);
	STD_ERROR.put_string " warning(s).\n";
      };
    };
    
    (is_statistic).if {            
      print "  Null call score      : " stat null_counter for late_binding_counter;            
      print "  Polymorphic call     : " stat polymorphic_counter for late_binding_counter;
      (is_optimization).if {
	"  Invariant loop score : ".print; count_invariant.print; '\n'.print;      
      };
    };
        
    //
    // Execute finality command (front end).
    //
    
    (command_list.lower).to (command_list.upper) do { j:INTEGER;
      (is_quiet_operation).if_false {
	STD_ERROR.put_string "Run `";
	STD_ERROR.put_string (command_list.item j); 
	STD_ERROR.put_string "' \t";
      };
      (ENVIRONMENT.execute_command (command_list.item j) = 0).if {
	(is_quiet_operation).if_false {
	  STD_ERROR.put_string "Ok\n";
	};
      } else {
	STD_ERROR.put_string "Failure!\n";
      };
    };        
  );

