--          This file is part of SmallEiffel The GNU Eiffel Compiler.
--          Copyright (C) 1994-98 LORIA - UHP - CRIN - INRIA - FRANCE
--            Dominique COLNET and Suzanne COLLIN - colnet@loria.fr
--                       http://SmallEiffel.loria.fr
-- SmallEiffel 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  2, or (at your option)  any  later
-- version. SmallEiffel 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  SmallEiffel;  see the file COPYING.  If not,
-- write to the  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-- Boston, MA 02111-1307, USA.
--
class EIFFEL_PARSER
   --
   -- Singleton object in charge of Eiffel parsing.
   -- This singleton is shared via the GLOBALS.`eiffel_parser' once function.
   --

inherit GLOBALS;

feature

   case_insensitive: BOOLEAN;
	 -- When flag "-case_insensitive" is on.

   no_style_warning: BOOLEAN;
	 -- When flag "-no_style_warning" is on.

   is_running: BOOLEAN;
	 -- True when the parser is running (ie. parsing of the
	 -- current class is not finished)..

feature {SMALL_EIFFEL}

   analyse_class(class_name: CLASS_NAME): BASE_CLASS is
      require
	 not is_running;
	 not small_eiffel.is_ready;
	 class_name.to_string /= Void;
	 parser_buffer.is_ready
      local
	 old_nbe, old_nbw: INTEGER;
	 path: STRING;
      do
	 current_id := id_provider.item(class_name.to_string);
	 path := parser_buffer.path;
	 if nb_errors > 0 then
	    eh.append("Correct previous error(s) first.");
	    eh.print_as_fatal_error;
	 end;
	 debug
	    if small_eiffel.is_ready then
	       eh.append("Tried to load class ");
	       eh.append(path);
	       eh.append(" while small_eiffel `is_ready'.");
	       eh.print_as_warning;
	    end;
	 end;
	 echo.put_integer(small_eiffel.base_class_count + 1);
	 echo.put_character('%T');
	 echo.put_string(path);
	 echo.put_character('%N');
	 old_nbe := nb_errors;
	 old_nbw := nb_warnings;
	 is_running := true;
	 inside_function := false;
	 inside_once_function := false;
	 in_ensure := false;
	 last_comment := Void;
	 line := 1;
	 column := 1;
	 current_line := parser_buffer.item(line);
	 if current_line.count = 0 then
	    cc := '%N';
	 else
	    cc := current_line.first;
	 end;
	 !!last_base_class.make(path,class_name.to_string,current_id);
	 skip_comments;
	 a_class_declaration;
	 is_running := false;
	 parser_buffer.unset_is_ready;
	 Result := last_base_class;
	 if nb_errors - old_nbe > 0 then
	    show_nb_errors;
	    echo.w_put_string("Load class %"");
	    echo.w_put_string(path);
	    echo.w_put_string("%" aborted.%N");
	    Result := Void;
	 elseif nb_warnings - old_nbw > 0 then
	    show_nb_warnings;
	    check
	       Result /= Void
	    end;
	 end;
	 if Result /= Void then
	    Result.get_started;
	 end;
      ensure
	 not parser_buffer.is_ready
      end;

feature {COMMAND_FLAGS}

   set_case_insensitive is
      do
	 case_insensitive := true;
      end;

   set_no_style_warning is
      do
	 no_style_warning := true;
      end;

feature {CECIL_FILE}

   connect_to_cecil(a_path: STRING): STRING is
	 -- Return the cecil file user's include path (first information).
      require
	 not is_running;
	 nb_errors = 0;
	 a_path /= Void
      local
	 path: STRING;
      do
	 echo.put_string("Parsing Cecil File : ");
	 echo.put_string(a_path);
	 echo.put_character('%N');
	 parser_buffer.load_file(a_path);
	 if not parser_buffer.is_ready then
	    fatal_error(
	       "Cannot open Cecil file (use -verbose flag for details).");
	 end;
	 path := parser_buffer.path;
	 current_id := id_provider.item(path);
	 is_running := true;
	 formal_generic_list := Void;
	 inside_function := false;
	 inside_once_function := false;
	 in_ensure := false;
	 last_comment := Void;
	 line := 1;
	 column := 1;
	 current_line := parser_buffer.item(line);
	 last_base_class := Void;
	 if current_line.count = 0 then
	    cc := '%N';
	 else
	    cc := current_line.first;
	 end;
	 skip_comments;
	 from
	    !!Result.make(32);
	 until
	    cc = '%N' or else cc = end_of_text
	 loop
	    Result.extend(cc);
	    next_char;
	 end;
	 skip_comments;
	 if cc = end_of_text then
	    fatal_error("Empty Cecil file (use -verbose flag for details).");
	 end;
      end;

   end_of_input: BOOLEAN is
      do
	 Result := cc = end_of_text;
      end;

   parse_c_name: STRING is
      do
	 from
	    !!Result.make(32);
	 until
	    cc.is_separator
	 loop
	    Result.extend(cc);
	    next_char;
	 end;
	 skip_comments;
      end;

   parse_run_type: TYPE is
      do
	 if a_class_type then
	    Result := last_class_type;
	 else
	    fcp(em16);
	 end;
      ensure
	 nb_errors = 0
      end;

   parse_feature_name: FEATURE_NAME is
      do
	 if a_feature_name then
	    Result := last_feature_name;
	 else
	    fcp(em2);
	 end;
      ensure
	 nb_errors = 0
      end;

   disconnect is
      do
	 is_running := false;
	 parser_buffer.unset_is_ready;
      end;

feature {C_PRETTY_PRINTER}

   show_nb_warnings is
      local
	 do_it: BOOLEAN;
      do
	 if echo.verbose then
	    do_it := true;
	 elseif eh.no_warning then
	 else
	    do_it := true;
	 end;
	 if do_it then
	    show_nb(nb_warnings," warning(s).%N");
	 end;
      end;

   show_nb_errors is
      do
	 show_nb(nb_errors," error(s).%N");
      end;

feature {COMPILE_TO_C,COMPILE_TO_JVM}

   set_drop_comments is
      do
	 drop_comments := true;
      end;

feature {TMP_FEATURE}

   ecp(msg: STRING) is
	 -- Error at current position.
      do
	 error(current_position,msg);
      end;

feature {NONE}

   end_of_text: CHARACTER is '%/0/'; -- Flag of the end of the `text'.

   last_comment: COMMENT;
	 -- Void or waiting comment.

   inside_function: BOOLEAN;
	 -- True when a function (once or non-once) is parsed.

   inside_once_function: BOOLEAN;
	 -- True when a once function is parsed.

   formal_generic_list: FORMAL_GENERIC_LIST;
	 -- Void or not empty list of formal generic arguments.

   in_ensure: BOOLEAN;
	 -- True during the parsing of a ensure clause.

   in_rescue: BOOLEAN;
	 -- True during the parsing of a rescue clause.

   arguments: FORMAL_ARG_LIST;
	 -- Void or actual formal arguments list.

   local_vars: LOCAL_VAR_LIST;
	 -- Void or actual local variables list.

   ok: BOOLEAN;
	 -- Dummy variable to call functions.

   tmp_name: TMP_NAME;

   last_ascii_code: INTEGER;
   last_base_class: BASE_CLASS;
   last_base_type: TYPE;
   last_binary: INFIX_NAME;
   last_bit_constant: BIT_CONSTANT;
   last_boolean_constant: BOOLEAN_CONSTANT;
   last_character_or_integer: BASE_TYPE_CONSTANT;
   last_character_constant: CHARACTER_CONSTANT;
   last_class_name: CLASS_NAME;
   last_class_type: TYPE;
   last_expression: EXPRESSION;
   last_feature_declaration: E_FEATURE;
   last_feature_name: FEATURE_NAME;
   last_feature_name_list: FEATURE_NAME_LIST;
   last_type_formal_generic: TYPE_FORMAL_GENERIC;
   last_infix: INFIX_NAME;
   last_prefix: PREFIX_NAME;
   last_integer_constant: INTEGER_CONSTANT;
   last_instruction: INSTRUCTION;
   last_index_value: EXPRESSION;
   last_manifest_constant: EXPRESSION;
   last_manifest_string: MANIFEST_STRING;
   last_parent: PARENT;
   last_real_constant: REAL_CONSTANT;
   last_type: TYPE;
   last_tag_mark: TAG_NAME;

   a_argument: BOOLEAN is
      local
	 rank: INTEGER;
      do
	 if arguments /= Void then
	    rank := arguments.rank_of(tmp_name.aliased_string);
	    if rank > 0 then
	       last_expression := tmp_name.to_argument_name2(arguments,rank);
	       Result := true;
	    end;
	 end;
      end;

   a_current: BOOLEAN is
      do
	 if tmp_name.is_current then
	    !WRITTEN_CURRENT!last_expression.make(tmp_name.start_position);
	    Result := true;
	 end;
      end;

   a_formal_arg_list is
	 --++ formal_arg_list -> ["(" {declaration_group ";" ...} ")"]
	 --++ declaration_group -> {identifier "," ...}+ ":" type
      local
	 name: ARGUMENT_NAME1;
	 name_list: ARRAY[ARGUMENT_NAME1];
	 declaration: DECLARATION;
	 list: ARRAY[DECLARATION];
	 state: INTEGER;
	 -- state 0 : waiting for the first name of a group.
	 -- state 1 : waiting "," or ":".
	 -- state 2 : waiting for a name (not the first).
	 -- state 3 : waiting for type mark.
	 -- state 4 : waiting ";" or ")".
	 -- state 5 : end.
	 -- state 6 : error.
      do
	 arguments := Void;
	 if skip1('(') then
	    from
	    until
	       state > 4
	    loop
	       inspect
		  state
	       when 0 then
		  if a_identifier then
		     name := tmp_name.to_argument_name1;
		     state := 1;
		  elseif skip1(')') then
		     state := 5;
		  else
		     state := 6;
		  end;
	       when 1 then
		  if skip1(':') then
		     if name_list /= Void then
			name_list.add_last(name);
			name := Void;
		     end;
		     state := 3;
		  else
		     ok := skip1(',');
		     if name_list = Void then
			!!name_list.with_capacity(2,1);
		     end;
		     name_list.add_last(name);
		     name := Void;
		     state := 2;
		  end;
	       when 2 then
		  if a_identifier then
		     name := tmp_name.to_argument_name1;
		     state := 1;
		  elseif cc = ',' or else cc = ';' then
		     wcp(em13);
		     ok := skip1(',') or else skip1(';');
		  else
		     state := 6;
		  end;
	       when 3 then
		  if a_type then
		     if name_list /= Void then
			!DECLARATION_GROUP!declaration.make(name_list,
			                                    last_type);
			name_list := Void;
		     else
			!DECLARATION_1!declaration.make(name,last_type);
			name := Void;
		     end;
		     if list = Void then
			!!list.with_capacity(2,1);
		     end;
		     list.add_last(declaration);
		     declaration := Void;
		     state := 4;
		  else
		     state := 6;
		  end;
	       else -- state = 4
		  if skip1(')') then
		     state := 5;
		  elseif cc = ',' then
		     wcp("Substitute with %";%".");
		     ok := skip1(',');
		     state := 0;
		  else
		     ok := skip1(';');
		     state := 0;
		  end;
	       end;
	    end;
	    if state = 6 then
	       fcp("Bad formal arguments list.");
	    elseif list = Void then
	       wcp("Empty formal argument list (deleted).");
	    else
	       !!arguments.make(list);
	       tmp_feature.set_arguments(arguments);
	    end;
	 end;
      end;

   a_local_var_list is
	 --++ local_var_list -> [{declaration_group ";" ...}]
	 --++ declaration_group -> {identifier "," ...}+ ":" type
      local
	 name: LOCAL_NAME1;
	 name_list: ARRAY[LOCAL_NAME1];
	 declaration: DECLARATION;
	 list: ARRAY[DECLARATION];
	 rank, state: INTEGER;
	 -- state 0 : waiting for the first name of a group.
	 -- state 1 : waiting "," or ":".
	 -- state 2 : waiting for a name (not the first).
	 -- state 3 : waiting for type mark.
	 -- state 4 : waiting ";".
	 -- state 5 : end.
	 -- state 6 : error.
      do
	 from
	 until
	    state > 4
	 loop
	    inspect
	       state
	    when 0 then
	       if a_identifier then
		  name := tmp_name.to_local_name1;
		  state := 1;
		  if arguments /= Void then
		     rank := arguments.rank_of(name.to_string);
		     if rank > 0 then
			eh.add_position(name.start_position);
			error(arguments.name(rank).start_position,
			      em26);
		     end;
		  end;
	       elseif cc = ',' or else cc = ';' then
		  wcp(em13);
		  ok := skip1(',') or else skip1(';');
	       else
		  state := 5;
	       end;
	    when 1 then
	       if skip1(':') then
		  if name_list /= Void then
		     name_list.add_last(name);
		     name := Void;
		  end;
		  state := 3;
	       else
		  if cc = ';' then
		     wcp("Substitute with %",%".");
		     ok := skip1(';');
		  else
		     ok := skip1(',');
		  end;
		  if name_list = Void then
		     !!name_list.with_capacity(2,1);
		  end;
		  name_list.add_last(name);
		  name := Void;
		  state := 2;
	       end;
	    when 2 then
	       if a_identifier then
		  name := tmp_name.to_local_name1;
		  state := 1;
		  if arguments /= Void then
		     rank := arguments.rank_of(name.to_string);
		     if rank > 0 then
			eh.add_position(name.start_position);
			eh.add_position(arguments.name(rank).start_position);
			eh.append(em26);
			eh.print_as_error;
		     end;
		  end;
	       elseif cc = ',' or else cc = ';' then
		  wcp(em13);
		  ok := skip1(',') or else skip1(';');
	       else
		  state := 6;
	       end;
	    when 3 then
	       if a_type then
		  if name_list /= Void then
		     !DECLARATION_GROUP!declaration.make(name_list,last_type);
		     name_list := Void;
		  else
		     !DECLARATION_1!declaration.make(name,last_type);
		     name := Void;
		  end;
		  if list = Void then
		     !!list.with_capacity(2,1);
		  end;
		  list.add_last(declaration);
		  state := 4;
	       else
		  state := 6;
	       end;
	    else -- state = 4
	       if cc = ',' then
		  wcp("Substitute with %";%".");
		  ok := skip1(',');
		  state := 0;
	       else
		  ok := skip1(';');
		  state := 0;
	       end;
	    end;
	 end;
	 if state = 6 then
	    fcp("Bad local variable list.");
	 elseif list /= Void then
	    !!local_vars.make(list);
	    tmp_feature.set_local_vars(local_vars);
	 end;
      end;

   a_local_variable: BOOLEAN is
      local
	 rank: INTEGER;
      do
	 if local_vars /= Void then
	    rank := local_vars.rank_of(tmp_name.aliased_string);
	    if rank > 0 then
	       last_expression := tmp_name.to_local_name2(local_vars,rank);
	       Result := true;
	    end;
	 end;
      end;

   a_result: BOOLEAN is
      do
	 if tmp_name.is_result then
	    last_expression := last_result;
	    Result := true;
	 end;
      end;

   a_void: BOOLEAN is
      do
	 if tmp_name.is_void then
	    last_expression := tmp_name.to_e_void;
	    Result := true;
	 end;
      end;

   get_comment: COMMENT is
      do
	 Result := last_comment;
	 last_comment := Void;
      end;

   start_line, start_column: INTEGER;
	 -- To store beginning position of : `a_keyword', `a_integer',
	 -- `a_real', `skip1', `skip2' and `skip1unless2'.

   a_keyword(keyword: STRING): BOOLEAN is
	 -- Look for `keyword' beginning strictly at current position.
	 -- A keyword is never followed by a character of
	 -- this set : 'A'..'Z','a'..'z','0'..'9','_'.
      require
	 keyword.count >= 1;
	 not keyword.has('%N')
      local
	 c, i, j: INTEGER;
      do
	 i := column;
	 c := keyword.count;
	 if current_line.count - i + 1 >= c then
	    from
	       start_line := line;
	       start_column := i;
	       j := 1;
	    until
	       c <= 0
	    loop
	       if current_line.item(i).same_as(keyword.item(j)) then
		  i := i + 1;
		  j := j + 1;
		  c := c - 1;
	       else
		  c := -1;
	       end;
	    end;
	 end;
	 if c = 0 then
	    if i > current_line.count then
	       Result := true;
	       cc := '%N';
	       column := i;
	       skip_comments;
	    else
	       inspect
		  current_line.item(i)
	       when ' ','%T','-' then
		  Result := true;
		  cc := current_line.item(i);
		  column := i;
		  skip_comments;
	       when 'a'..'z','A'..'Z','0'..'9','_' then
	       else
		  Result := true;
		  cc := current_line.item(i);
		  column := i;
	       end;
	    end;
	 end;
      end;

   a_ascii_code is
	 -- To read a character given as an ascii code in a manifest
	 -- constant CHARACTER or STRING;
	 -- Require/Ensure : cc = '/'.
      local
	 counter: INTEGER;
      do
	 from
	    check
	       cc = '/'
	    end;
	    next_char;
	    counter := 0;
	    last_ascii_code := 0;
	 until
	    counter > 3 or else cc = '/'
	 loop
	    inspect
	       cc
	    when '0' .. '9' then
	       last_ascii_code := last_ascii_code * 10 + cc.value;
	    else
	       fcp("Unexpected character in ascii code.");
	    end;
	    counter := counter + 1;
	    next_char;
	 end;
	 if counter = 0 then
	    fcp("Bad (empty ?) ascii code.");
	 elseif counter > 3 then
	    fcp("Three digit is enought for an ascii code.");
	 else
	    check
	       cc = '/'
	    end;
	 end;
      end;

   go_back_at(l, c: INTEGER) is
	 -- Go back to some existing line `l', and column `c'.
      require
	 l >= 1; c >= 1
      do
	 line := l;
	 column := c;
	 current_line := parser_buffer.item(l);
	 cc := current_line.item(c);
	 last_comment := Void;
      end;

   next_char is
      do
	 if column < current_line.count then
	    column := column + 1;
	    cc := current_line.item(column);
	 elseif column = current_line.count then
	    column := column + 1;
	    cc := '%N';
	 elseif line = parser_buffer.count then
	    cc := end_of_text;
	 else
	    line := line + 1;
	    column := 1;
	    current_line := parser_buffer.item(line);
	    if current_line.count = 0 then
	       cc := '%N';
	    else
	       cc := current_line.first;
	    end;
	 end;
      end;

   skip1(char: CHARACTER): BOOLEAN is
      do
	 if char = cc then
	    start_line := line;
	    start_column := column;
	    Result := true;
	    next_char;
	    skip_comments;
	 end;
      end;

   skip2(c1, c2: CHARACTER): BOOLEAN is
      do
	 if c1 = cc then
	    start_line := line;
	    start_column := column;
	    next_char;
	    if c2 = cc then
	       Result := true;
	       next_char;
	       skip_comments;
	    else
	       cc := c1;
	       column := start_column;
	    end;
	 end;
      end;

   skip1unless2(c1, c2: CHARACTER): BOOLEAN is
      do
	 start_line := line;
	 start_column := column;
	 if cc = c1 then
	    next_char;
	    if cc = c2 then
	       cc := c1;
	       column := start_column;
	    else
	       Result := true;
	       skip_comments;
	    end;
	 end;
      end;

   skip_comments is
	 -- Skip separators and comments if any. Unless `drop_comments', 
	 -- comments are stored in `last_comment'.
      local
	 sp: POSITION; stop: BOOLEAN;
      do
	 from
	 until
	    stop
	 loop
	    inspect
	       cc
	    when ' ','%T','%N' then
	       next_char;
	    when '-' then
	       next_char;
	       if cc = '-' then
		  if drop_comments then
		     if line = parser_buffer.count then
			cc := end_of_text;
			stop := true;
		     else
			line := line + 1;
			column := 1;
			current_line := parser_buffer.item(line);
			if current_line.count = 0 then
			   cc := '%N';
			else
			   cc := current_line.first;
			end;
		     end;
		  else
		     from
			sp := pos(line,column - 1);
			next_char;
			lcs.clear;
		     until
			cc = '%N'
		     loop
			lcs.extend(cc);
			next_char;
		     end;
		     if last_comment = Void then
			!!last_comment.make(sp,lcs.twin);
		     else
			last_comment.add_last(lcs.twin);
		     end;
		  end;
	       else
		  cc := '-';
		  column := column - 1;
		  stop := true;
	       end;
	    else
	       stop := true;
	    end;
	 end;
      end;

   a_bit_constant: BOOLEAN is
      local
	 l, c, state: INTEGER;
	 -- state 0 : first bit read.
	 -- state 1 : happy end.
	 -- state 2 : error end.
      do
	 if cc = '0' or else cc = '1' then
	    from
	       l := line;
	       c := column;
	       buffer.clear;
	       buffer.extend(cc);
	    until
	       state > 0
	    loop
	       next_char;
	       inspect
		  cc
	       when '0','1' then
		  buffer.extend(cc);
	       when 'b','B' then
		  !!last_bit_constant.make(pos(l,c),buffer.twin);
		  next_char;
		  skip_comments;
		  state := 1;
		  Result := true;
	       else
		  go_back_at(l,c);
		  state := 2;
	       end;
	    end;
	 end;
      end;

   a_character_constant: BOOLEAN is
      local
	 sp: POSITION;
	 state, printing_mode: INTEGER;
	 value: CHARACTER;
	 -- state 0 : first '%'' read.
	 -- state 1 : first '%%' read.
	 -- state 2 : wait for second '%''.
	 -- state 3 : happy end.
      do
	 if cc = '%'' then
	    from
	       sp := pos(line,column);
	       Result := true;
	    until
	       state > 2
	    loop
	       next_char;
	       inspect
		  state
	       when 0 then
		  inspect
		     cc
		  when '%%' then
		     state := 1;
		  when '%'' then
		     fcp(em10);
		     state := 2;
		  else
		     value := cc;
		     printing_mode := 0;
		     state := 2;
		  end;
	       when 1 then
		  printing_mode := 1;
		  state := 2;
		  inspect
		     cc
		  when 'A' then
		     value := '%A';
		  when 'B' then
		     value := '%B';
		  when 'C' then
		     value := '%C';
		  when 'D' then
		     value := '%D';
		  when 'F' then
		     value := '%F';
		  when 'H' then
		     value := '%H';
		  when 'L' then
		     value := '%L';
		  when 'N' then
		     value := '%N';
		  when 'Q' then
		     value := '%Q';
		  when 'R' then
		     value := '%R';
		  when 'S' then
		     value := '%S';
		  when 'T' then
		     value := '%T';
		  when 'U' then
		     value := '%U';
		  when 'V' then
		     value := '%V';
		  when '%%' then
		     value := '%%';
		  when '%'' then
		     value := '%'';
		  when '%"' then
		     value := '%"';
		  when '(' then
		     value := '%(';
		  when ')' then
		     value := '%)';
		  when '<' then
		     value := '%<';
		  when '>' then
		     value := '%>';
		  when '/' then
		     a_ascii_code;
		     value := last_ascii_code.to_character;
		     printing_mode := 2;
		  else
		     fcp("Unknown special character.");
		  end;
	       else -- state = 2
		  state := 3;
		  inspect
		     cc
		  when '%'' then
		  else
		     fcp(em10);
		  end;
		  next_char;
		  skip_comments;
	       end;
	    end;
	    !!last_character_constant.make(sp,value,printing_mode);
	 end;
      end;

   a_constant: BOOLEAN is
	 -- Only true for constant allowed in "when of inspect".
      local
	 implicit_current: IMPLICIT_CURRENT;
	 sfn: SIMPLE_FEATURE_NAME;
      do
	 if a_identifier then
	    Result := true;
	    sfn := tmp_name.to_simple_feature_name;
	    !!implicit_current.make(sfn.start_position);
	    !CALL_0_C!last_expression.make(implicit_current,sfn);
	 elseif a_character_constant then
	    Result := true;
	    last_expression := last_character_constant;
	 elseif a_integer_constant then
	    Result := true;
	    last_expression := last_integer_constant;
	 end;
      end;

   a_base_class_name: BOOLEAN is
      local
	 state, c: INTEGER;
	 do_warning: BOOLEAN;
	 -- state 0 : first letter read.
	 -- state 1 : end.
      do
	 if cc.is_letter then
	    from
	       if cc >= 'a' then
		  do_warning := true;
		  cc := cc.to_upper;
	       end;
	       c := column;
	       tmp_name.reset(pos(line,c));
	       tmp_name.extend(cc);
	    until
	       state > 0
	    loop
	       next_char;
	       inspect
		  cc
	       when 'A'..'Z','0'..'9','_' then
		  tmp_name.extend(cc);
	       when 'a'..'z' then
		  do_warning := true;
		  tmp_name.extend(cc.to_upper);
	       else
		  state := 1;
	       end;
	    end;
	    if tmp_name.isa_keyword then
	       cc := tmp_name.buffer.first;
	       column := c;
	    else
	       Result := true;
	       skip_comments;
	       if do_warning then
		  warning(tmp_name.start_position,em14);
	       end;
	       last_class_name := tmp_name.to_class_name;
	    end;
	 end;
      end;

   a_base_class_name1 is
	 -- Read the current base class name.
      local
	 cn: CLASS_NAME;
	 bc: BASE_CLASS;
      do
	 bc := last_base_class;
	 cn := bc.name;
	 cn.set_accurate_position(pos(line,column));
	 if a_base_class_name then
	    if last_class_name.to_string /= cn.to_string then
	       eh.add_position(last_class_name.start_position);
	       eh.append(fz_01);
	       eh.append(bc.path);
	       eh.append("%" does not contains class %"");
	       eh.append(cn.to_string);
	       fatal_error(fz_03);
	    end;
	 else
	    fcp(em15);
	 end;
	 if as_none = cn.to_string then
	    eh.add_position(cn.start_position);
	    fatal_error("Cannot write such a class.");
	 end;
      end;
   
   a_type_formal_generic: BOOLEAN is
      local
	 fga: FORMAL_GENERIC_ARG;
	 cn: CLASS_NAME;
	 rank: INTEGER;
      do
	 if formal_generic_list /= Void then
	    from
	       rank := 1;
	    until
	       Result or else rank > formal_generic_list.count
	    loop
	       fga := formal_generic_list.item(rank);
	       if a_keyword(fga.name.to_string) then
		  !!cn.make(fga.name.to_string,pos(start_line,start_column));
		  !!last_type_formal_generic.make(cn,fga,rank);
		  Result := true;
	       end;
	       rank := rank + 1;
	    end;
	 end;
      end;

   a_free_operator: BOOLEAN is
	 --++ free_operator -> "@..." |
	 --++                  "#..." |
	 --++                  "|..." |
	 --++                  "&..."
	 --++
      do
	 if (cc = '@') or else
	    (cc = '#') or else
	    (cc = '|') or else
	    (cc = '&') then
	    Result := true;
	    from
	       tmp_name.reset(pos(line,column));
	       tmp_name.extend(cc);
	       next_char;
	    until
	       (cc = '%N') or else
	       (cc = ' ') or else
	       (cc = '%T') or else
	       (cc = '%"')
	    loop
	       tmp_name.extend(cc);
	       next_char;
	    end;
	    skip_comments;
	 end;
      end;

   a_identifier: BOOLEAN is
      do
	 if case_insensitive then
	    Result := a_identifier1;
	 else
	    Result := a_identifier2;
	 end;
      end;

   a_integer: BOOLEAN is
      local
	 sp: POSITION;
	 state, value: INTEGER;
	 -- state 0 : 1st digit read (no '_' encountered).
	 -- state 1 : 2nd digit read (no '_' encountered).
	 -- state 2 : 3rd digit read (no '_' encountered).
	 -- state 3 : more than 3 digit read (no '_' encountered).
	 -- state 4 : after '_'.
	 -- state 5 : after '_' and 1 digit read.
	 -- state 6 : after '_' and 2 digit read.
	 -- state 7 : after '_' and 3 digit read.
	 -- state 8 : satisfaction state.
      do
	 if cc.is_digit then
	    from
	       Result := true;
	       sp := pos(line,column);
	       value := cc.value;
	    until
	       state > 7
	    loop
	       next_char;
	       inspect
		  state
	       when 0 then
		  inspect
		     cc
		  when '0'..'9' then
		     value := value * 10 + cc.value;
		     state := 1;
		  when '_' then
		     state := 4;
		  else
		     state := 8;
		  end;
	       when 1 then
		  inspect
		     cc
		  when '0'..'9' then
		     value := value * 10 + cc.value;
		     state := 2;
		  when '_' then
		     state := 4;
		  else
		     state := 8;
		  end;
	       when 2 then
		  inspect
		     cc
		  when '0'..'9' then
		     value := value * 10 + cc.value;
		     state := 3;
		  when '_' then
		     state := 4;
		  else
		     state := 8;
		  end;
	       when 3 then
		  inspect
		     cc
		  when '0'..'9' then
		     value := value * 10 + cc.value;
		  when '_' then
		     fcp(em9);
		  else
		     state := 8;
		  end;
	       when 4 then
		  inspect
		     cc
		  when '0'..'9' then
		     value := value * 10 + cc.value;
		     state := 5;
		  else
		     fcp(em9);
		  end;
	       when 5 then
		  inspect
		     cc
		  when '0'..'9' then
		     value := value * 10 + cc.value;
		     state := 6;
		  else
		     fcp(em9);
		  end;
	       when 6 then
		  inspect
		     cc
		  when '0'..'9' then
		     value := value * 10 + cc.value;
		     state := 7;
		  else
		     fcp(em9);
		  end;
	       when 7 then
		  inspect
		     cc
		  when '0'..'9' then
		     fcp(em9);
		  when '_' then
		     state := 4;
		  else
		     state := 8;
		  end;
	       end;
	    end;
	    if cc.is_letter then
	       fcp(em17);
	    end;
	    skip_comments;
	    !!last_integer_constant.make(value,sp);
	 end;
      end;

   a_manifest_string: BOOLEAN is
      local
	 state: INTEGER;
	 -- state 0 : inside string.
	 -- state 1 : just read a '%%'.
	 -- state 2 : extended form starting (waiting for '%N').
	 -- state 3 : extended form ending (waiting for '%%').
	 -- state 4 : happy end.
      do
	 if cc = '%"' then
	    from
	       Result := true;
	       !!last_manifest_string.make(pos(line,column));
	    until
	       state > 3
	    loop
	       next_char;
	       inspect
		  state
	       when 0 then
		  inspect
		     cc
		  when '%N' then
		     fcp(em8);
		  when '%"' then
		     state := 4;
		  when '%%' then
		     state := 1;
		  else
		     last_manifest_string.add(cc);
		  end;
	       when 1 then
		  state := 0;
		  inspect
		     cc
		  when '%N' then
		     state := 3;
		  when 'A' then
		     last_manifest_string.add_percent('%A');
		  when 'B' then
		     last_manifest_string.add_percent('%B');
		  when 'C' then
		     last_manifest_string.add_percent('%C');
		  when 'D' then
		     last_manifest_string.add_percent('%D');
		  when 'F' then
		     last_manifest_string.add_percent('%F');
		  when 'H' then
		     last_manifest_string.add_percent('%H');
		  when 'L' then
		     last_manifest_string.add_percent('%L');
		  when 'N' then
		     last_manifest_string.add_percent('%N');
		  when 'Q' then
		     last_manifest_string.add_percent('%Q');
		  when 'R' then
		     last_manifest_string.add_percent('%R');
		  when 'S' then
		     last_manifest_string.add_percent('%S');
		  when 'T' then
		     last_manifest_string.add_percent('%T');
		  when 'U' then
		     last_manifest_string.add_percent('%U');
		  when 'V' then
		     last_manifest_string.add_percent('%V');
		  when '%%' then
		     last_manifest_string.add_percent('%%');
		  when '%'' then
		     last_manifest_string.add_percent('%'');
		  when '%"' then
		     last_manifest_string.add_percent('%"');
		  when '(' then
		     last_manifest_string.add_percent('%(');
		  when ')' then
		     last_manifest_string.add_percent('%)');
		  when '<' then
		     last_manifest_string.add_percent('%<');
		  when '>' then
		     last_manifest_string.add_percent('%>');
		  when '/' then
		     a_ascii_code;
		     last_manifest_string.add_ascii(last_ascii_code.to_character);
		  when ' ','%T' then
		     state := 2;
		  else
		     fcp("Unknown special character.");
		     state := 0;
		  end;
	       when 2 then
		  inspect
		     cc
		  when '%N' then
		     state := 3;
		  when ' ','%T' then
		  else
		     fcp("In extended form of manifest string.%
			 %Bad character after '%%'.");
		  end;
	       else -- state = 3
		  inspect
		     cc
		  when ' ','%T' then
		  when '%%' then
		     last_manifest_string.break_line;
		     state := 0;
		  when '%N' then
		     fcp(em8);
		     state := 0;
		  else
		     fcp("In extended form of manifest string.%
			 % Bad character before '%%'.");
		     state := 0;
		  end;
	       end;
	    end;
	    next_char;
	    skip_comments;
	 end;
      end;

   a_real: BOOLEAN is
      local
	 state, l, c: INTEGER;
	 -- state 0  : reading integral part.
	 -- state 1  : reading integral part after '_'.
	 -- state 2  : reading integral part after '_' and 1 digit.
	 -- state 3  : reading integral part after '_' and 2 digits.
	 -- state 4  : '.' read and not empty integral_part.
	 -- state 5  : '.' read and empty integral_part.
	 -- state 6  : reading frac_part.
	 -- state 7  : reading frac_part after '_'.
	 -- state 8  : reading frac_part after '_' and 1 digit.
	 -- state 9  : reading frac_part after '_' and 2 digits.
	 -- state 10 : 'E' or 'e' read.
	 -- state 11 : reading exponent.
	 -- state 12 : happy end.
	 -- state 13 : error end.
      do
	 if cc.is_digit or else cc = '.' then
	    from
	       l := line;
	       c := column;
	       buffer.clear;
	       if cc = '.' then
		  buffer.append(fz_59);
		  state := 5;
	       else
		  buffer.extend(cc);
	       end;
	    until
	       state > 11
	    loop
	       next_char;
	       inspect
		  state
	       when 0 then
		  inspect
		     cc
		  when '0' .. '9' then
		     buffer.extend(cc);
		  when '.' then
		     buffer.extend('.');
		     state := 4;
		  else
		     state := 13;
		  end;
	       when 1 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 2;
		  else
		     fcp(em9);
		  end;
	       when 2 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 3;
		  else
		     fcp(em9);
		  end;
	       when 3 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 0;
		  else
		     fcp(em9);
		  end;
	       when 4 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 6;
		  when 'E','e' then
		     buffer.extend('E');
		     state := 10;
		  else
		     state := 12;
		  end;
	       when 5 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 6;
		  else
		     state := 13;
		  end;
	       when 6 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		  when 'E','e' then
		     buffer.extend('E');
		     state := 10;
		  when '_' then
		     state := 7;
		  else
		     state := 12;
		  end;
	       when 7 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 8;
		  else
		     fcp(em1);
		  end;
	       when 8 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 9;
		  else
		     fcp(em1);
		  end;
	       when 9 then
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 6;
		  else
		     fcp(em1);
		  end;
	       when 10 then
		  inspect
		     cc
		  when '+' then
		     state := 11;
		  when '-' then
		     buffer.extend('-');
		     state := 11;
		  when '0'..'9' then
		     buffer.extend(cc);
		     state := 11
		  else
		     fcp("Exponent of a real value expected.");
		     state := 13;
		  end;
	       else -- state = 11
		  inspect
		     cc
		  when '0'..'9' then
		     buffer.extend(cc);
		  else
		     state := 12;
		  end;
	       end;
	    end;
	    if state = 12 then
	       !!last_real_constant.make(pos(l,c),buffer.twin);
	       Result := true;
	       skip_comments;
	    else
	       go_back_at(l,c);
	    end;
	 end;
      end;

   a_retry: BOOLEAN is
      do
	 if a_keyword(fz_retry) then
	    if not in_rescue then
	       error(pos(start_line,start_column),
		     "%"retry%" cannot be outside of a rescue clause.");
	    end;
	    !E_RETRY!last_instruction.make(pos(start_line,start_column));
	    Result := true;
	 end;
      end;

   a_actual: BOOLEAN is
	 --++ actual -> expression |
	 --++           "$" identifier
	 --++
      do
	 if skip1('%D') then
	    if a_identifier then
	       if a_result or else a_void or else a_current then
		  eh.add_position(last_expression.start_position);
		  fatal_error(fz_vuar4);
	       else
		  !ADDRESS_OF!last_expression.make(tmp_name.to_simple_feature_name);
		  Result:= true;
	       end;
	    else
	       fcp(fz_vuar4);
	    end;
	 elseif a_expression then
	    Result := true;
	 end;
      end;

   a_actuals: EFFECTIVE_ARG_LIST is
	 --++ actuals -> "(" {actual "," ...} ")"
	 --++
      local
	 first_one: EXPRESSION;
	 remainder: FIXED_ARRAY[EXPRESSION];
      do
	 if skip1('(') then
	    from
	    until
	       not a_actual
	    loop
	       if first_one = Void then
		  first_one := last_expression;
	       else
		  if remainder = Void then
		     !!remainder.with_capacity(4);
		  end;
		  remainder.add_last(last_expression);
	       end;
	       if not skip1(',') and then cc /= ')' then
	          wcp(em5);
	       end;
	    end;
	    if first_one = Void then
	       wcp("Empty argument list (deleted).");
	    else
	       !!Result.make_n(first_one,remainder);
	    end;
	    if not skip1(')') then
	       fcp("')' expected to end arguments list.");
	    end;
	 end;
      end;

   a_after_a_dot(do_instruction: BOOLEAN; target: EXPRESSION) is
	 --++ after_a_dot -> identifier [actuals] ["." after_a_dot]
	 --++
      require
	 target /= Void
      local
	 sfn: SIMPLE_FEATURE_NAME;
	 eal: EFFECTIVE_ARG_LIST;
      do
	 if a_identifier then
	    if a_result or else a_void or else a_current then
	       error(last_expression.start_position,
		     "This name must not appear after a dot.");
	    end;
	    sfn := tmp_name.to_simple_feature_name;
	    eal := a_actuals;
	    a_r10(do_instruction,target,sfn,eal);
	 else
	    fcp("Identifier expected after a dot.");
	 end;
      end;

   a_assignment_or_call: BOOLEAN is
	 --++ assignment_or_call -> "(" expression ")" r10 |
	 --++                       precursor_call |
	 --++                       "Current" r10 |
	 --++                       "Result" r10 |
	 --++                       local_variable r10 |
	 --++                       formal_argument r10 |
	 --++                       writable ":=" expression |
	 --++                       writable "?=" expression |
	 --++                       identifier procedure_call
	 --++
      do
	 if skip1('(') and then a_expression then
	    Result := true;
	    if skip1(')') then
	       a_r10(true,last_expression,Void,Void);
	    else
	       fcp("')' expected.");
	    end;
	 elseif a_precursor(true) then
	    Result := true;
	 elseif a_identifier then
	    Result := true;
	    if skip2(':','=') then
	       a_assignment_aux(true);
	    elseif skip2('?','=') then
	       a_assignment_aux(false);
	    elseif a_current or else a_result or else a_local_variable
	       or else a_argument then
	       a_r10(true,last_expression,Void,Void);
	    else
	       a_procedure_call;
	    end;
	 end;
      end;

   a_assignment_aux(regular: BOOLEAN) is
      local
	 writable, rhs: EXPRESSION;
      do
	 if a_current then
	    eh.add_position(last_expression.start_position);
	    fatal_error("Must not affect `Current'.");
	 elseif a_void then
	    eh.add_position(tmp_name.start_position);
	    fatal_error("Must not affect `Void'.");
	 elseif a_argument then
	    eh.add_position(last_expression.start_position);
	    fatal_error("Must not affect a formal argument.");
	 else
	    if tmp_name.is_result then
	       writable := last_result;
	    elseif a_local_variable then
	       writable := last_expression;
	    else
	       writable := tmp_name.to_simple_feature_name;
	    end;
	    if a_expression then
	       rhs := last_expression;
	       if regular then
		  !ASSIGNMENT!last_instruction.make(writable,rhs);
	       else
		  !REVERSE_ASSIGNMENT!last_instruction.make(writable,rhs);
	       end;
	    else
	       fcp("Right hand side expression expected for assignment.");
	    end;
	 end;
      end;

   a_assertion_buffer: ARRAY[ASSERTION] is
	 -- Used only inside `a_assertion'.
      once
	 !!Result.with_capacity(32,1);
      end;

   a_assertion: ARRAY[ASSERTION] is
	 --++ assertion -> {assertion_clause ";" ...}
	 --++ assertion_clause -> [identifier ":"] [expression] [comment]
	 --++
      local
	 tag: like last_tag_mark;
	 expression: like last_expression;
	 assertion: ASSERTION;
	 state: INTEGER;
	 -- state 0 : nothing read.
	 -- state 1 : read a `tag'.
	 -- state 2 : read an `expression'.
	 -- state 3 : read a `tag' and an `expression'.
	 -- state 4 : end;
      do
	 from
	    a_assertion_buffer.clear;
	 until
	    state > 3
	 loop
	    inspect
	       state
	    when 0 then
	       if cc = ';' then
		  wcp(em24);
		  ok := skip1(';');
	       elseif last_comment /= Void then
		  !!assertion.make(Void,Void,get_comment);
		  a_assertion_buffer.add_last(assertion);
	       elseif a_tag_mark then
		  tag := last_tag_mark;
		  state := 1;
	       elseif a_expression then
		  expression := last_expression;
		  state := 2;
	       else
		  state := 4;
	       end;
	    when 1 then
	       if skip1(';') then
		  !!assertion.make(tag,Void,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  state := 0;
	       elseif a_tag_mark then
		  !!assertion.make(tag,Void,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  tag := last_tag_mark;
	       elseif a_expression then
		  expression := last_expression;
		  state := 3;
	       else
		  !!assertion.make(tag,Void,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  state := 4;
	       end;
	    when 2 then
	       if skip1(';') then
		  !!assertion.make(Void,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  state := 0;
	       elseif a_tag_mark then
		  !!assertion.make(Void,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  tag := last_tag_mark;
		  state := 1;
	       elseif a_expression then
		  !!assertion.make(Void,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  expression := last_expression;
		  state := 2;
	       else
		  !!assertion.make(Void,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  state := 4;
	       end;
	    else -- state = 3
	       if skip1(';') then
		  !!assertion.make(tag,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  state := 0;
	       elseif a_tag_mark then
		  !!assertion.make(tag,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  tag := last_tag_mark;
		  state := 1;
	       elseif a_expression then
		  !!assertion.make(tag,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  expression := last_expression;
		  state := 2;
	       else
		  !!assertion.make(tag,expression,get_comment);
		  a_assertion_buffer.add_last(assertion);
		  state := 4;
	       end;
	    end;
	 end;
	 if not a_assertion_buffer.is_empty then
	    Result := a_assertion_buffer.twin;
	 end;
      end;

   a_base_type: BOOLEAN is
	 --++ base_type -> "ANY" | ARRAY "[" type "]" | "BOOLEAN" |
	 --++         "CHARACTER" | "DOUBLE" | "INTEGER" | "NONE" |
	 --++         "POINTER" | "REAL" | "STRING"
	 --++
      local
	 sp: POSITION;
	 types: ARRAY[TYPE];
      do
	 Result := true;
	 if a_keyword(as_any) then
	    !TYPE_ANY!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_array) then
	    sp := pos(start_line,start_column);
	    if skip1('[') and then a_type and then skip1(']') then
	       check
		  last_type /= Void
	       end;
	       !TYPE_ARRAY!last_base_type.make(sp,last_type);
	    else
	       fcp("Bad use of predefined type ARRAY.");
	    end;
	 elseif a_keyword(as_native_array) then
	    sp := pos(start_line,start_column);
	    if skip1('[') and then a_type and then skip1(']') then
	       check
		  last_type /= Void
	       end;
	       !TYPE_NATIVE_ARRAY!last_base_type.make(sp,last_type);
	    else
	       fcp("Bad use of predefined type NATIVE_ARRAY.");
	    end;
	 elseif a_keyword(as_boolean) then
	    !TYPE_BOOLEAN!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_character) then
	    !TYPE_CHARACTER!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_double) then
	    !TYPE_DOUBLE!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_integer) then
	    !TYPE_INTEGER!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_none) then
	    !TYPE_NONE!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_pointer) then
	    !TYPE_POINTER!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_real) then
	    !TYPE_REAL!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_string) then
	    !TYPE_STRING!last_base_type.make(pos(start_line,start_column));
	 elseif a_keyword(as_tuple) then
	    sp := pos(start_line,start_column);
	    if skip1('[') then
	       from 
		  !!types.with_capacity(4,1);
	       until 
		  skip1(']')
	       loop
		  if a_type then
		     types.add_last(last_type);
		     if not skip1(',') then
			if cc /= ']' then
			   wcp(em5);
			end;
		     end;
		  else
		     eh.add_position(current_position);
		     eh.append("Incorrect TUPLE (type expected).");
		     eh.print_as_fatal_error;
		  end;
	       end;
	    end;
	    !TYPE_TUPLE!last_base_type.make(sp,types);
	 else
	    Result := false;
	 end;
      end;

   a_binary(sp: POSITION): BOOLEAN is
	 --++ binary -> "<=" | ">=" | "//" | "\\" |
	 --++           "+" | "-" | "*" | "/" | "<" | ">" | "^" |
	 --++           xor" | "implies" | "and then" | "and" | "or else" | "or"
	 --++
      do
	 Result := true;
	 if skip2('<','=') then
	    !!last_binary.make(as_le,sp);
	 elseif skip2('>','=') then
	    !!last_binary.make(as_ge,sp);
	 elseif skip2('/','/') then
	    !!last_binary.make(as_slash_slash,sp);
	 elseif skip2('\','\') then
	    !!last_binary.make(as_backslash_backslash,sp);
	 elseif skip1('+') then
	    !!last_binary.make(as_plus,sp);
	 elseif skip1('-') then
	    !!last_binary.make(as_minus,sp);
	 elseif skip1('*') then
	    !!last_binary.make(as_muls,sp);
	 elseif skip1('/') then
	    !!last_binary.make(as_slash,sp);
	 elseif skip1('>') then
	    !!last_binary.make(as_gt,sp);
	 elseif skip1('<') then
	    !!last_binary.make(as_lt,sp);
	 elseif skip1('^') then
	    !!last_binary.make(as_pow,sp);
	 elseif a_keyword(as_xor) then
	    !!last_binary.make(as_xor,sp);
	 elseif a_keyword(as_implies) then
	    !!last_binary.make(as_implies,sp)
	 elseif a_keyword(as_and) then
	    if a_keyword(fz_then) then
	       !!last_binary.make(as_and_then,sp);
	    else
	       !!last_binary.make(as_and,sp);
	    end;
	 elseif a_keyword(as_or) then
	    if a_keyword(fz_else) then
	       !!last_binary.make(as_or_else,sp);
	    else
	       !!last_binary.make(as_or,sp);
	    end;
	 else
	    last_binary := Void;
	    Result := false;
	 end;
      end;

   a_boolean_constant: BOOLEAN is
	 --++ boolean_constant -> "true" | "false"
	 --++
      do
	 if a_keyword(fz_true) then
	    !E_TRUE!last_boolean_constant.make(pos(start_line,start_column));
	    Result := true;
	 elseif a_keyword(fz_false) then
	    !E_FALSE!last_boolean_constant.make(pos(start_line,start_column));
	    Result := true;
	 end;
      end;

   a_character_or_integer: BOOLEAN is
	 --++ character_or_integer -> character_constant |
	 --++                         integer_constant
	 --++
      do
	 if a_character_constant then
	    last_character_or_integer := last_character_constant;
	    Result := true;
	 elseif a_integer_constant then
	    last_character_or_integer := last_integer_constant;
	    Result := true;
	 end;
      end;

   a_check: BOOLEAN is
	 --++ check -> "check" assertion "end"
	 --++
      local
	 sp: POSITION;
	 hc: COMMENT;
	 al: ARRAY[ASSERTION];
      do
	 if a_keyword(fz_check) then
	    sp := pos(start_line,start_column);
	    hc := get_comment;
	    al := a_assertion;
	    if not a_keyword(fz_end) then
	       eh.add_position(sp);
	       fcp("Keyword %"end%" expected at the end of check clause.");
	    end;
	    if hc /= Void or else al /= Void then
	       !E_CHECK!last_instruction.make(sp,hc,al);
	       Result := true;
	    elseif skip1(';') then
	    end;
	 end;
      end;

   a_class_declaration is
	 --++ class_declaration -> [indexing]
	 --++                      ["expanded" | "deferred"]
	 --++                      "class" base_class_name
	 --++                      ["[" formal_generic_list "]"]
	 --++                      [comment]
	 --++                      ["obsolete" manifest_string]
	 --++                      ["inherit" parent_list]
	 --++                      {"creation" creation_clause ...}
	 --++                      {"create" creation_clause ...}
	 --++                      {"feature" feature_clause ...}
	 --++                      ["invariant" assertion]
	 --++                      "end"
	 --++
      local
	 sp: POSITION;
	 hc: COMMENT;
	 al: ARRAY[ASSERTION];
	 drop_comments_save, end_of_class_flag: BOOLEAN;
      do
	 a_indexing;
	 if a_keyword(fz_deferred) then
	    last_base_class.set_is_deferred;
	 end;
	 if a_keyword(fz_expanded) then
	    last_base_class.set_is_expanded;
	    if a_keyword(fz_deferred) then
	       last_base_class.set_is_deferred;
	    end;
	 end;
	 last_base_class.set_heading_comment1(get_comment);
	 if not a_keyword(fz_class) then
	    fcp("Keyword %"class%" expected.");
	 end;
	 a_base_class_name1;
	 a_formal_generic_list;
	 if a_keyword(fz_obsolete) then
	    if a_manifest_string then
	       last_base_class.set_obsolete_type_string(last_manifest_string);
	    else
	       fcp("Manifest string expected for %"obsolete%" clause.");
	    end;
	 end;
	 last_base_class.set_heading_comment2(get_comment);
	 if a_keyword(fz_inherit) then
	    end_of_class_flag := true;
	    a_parent_list(pos(start_line,start_column),get_comment);
	 end;
	 from
	 until
	    not (a_keyword(fz_creation) or else a_keyword(fz_create))
	 loop
	    a_creation_clause(pos(start_line,start_column));
	    end_of_class_flag := false;
	 end;
	 from
	 until
	    not a_keyword(fz_feature)
	 loop
	    a_feature_clause;
	    end_of_class_flag := false;
	 end;
	 drop_comments_save := drop_comments;
	 drop_comments := false;
	 if a_keyword(fz_invariant) then
	    end_of_class_flag := false;
	    sp := pos(start_line,start_column);
	    hc := get_comment;
	    al := a_assertion;
	    last_base_class.set_invariant(sp,hc,al);
	 end;
	 if a_keyword(fz_end) or else end_of_class_flag then
	    if cc = ';' then
	       wcp(em24);
	       ok := skip1(';');
	    end;
	    last_base_class.set_end_comment(get_comment);
	    if cc /= end_of_text then
	       fcp("End of text expected.");
	    end;
	 else
	    fcp("Keyword %"end%" expected at the end of a class.");
	 end;
	 drop_comments := drop_comments_save;
      end;

   a_class_type: BOOLEAN is
	 --++ class_type -> base_type |
	 --++               base_class_name ["[" {type "," ...} "]"]
	 --++
      local
	 state: INTEGER;
	 base_class_name: CLASS_NAME;
	 generic_list: ARRAY[TYPE];
	 -- state 0 : `base_class_name' read.
	 -- state 1 : waiting next generic argument.
	 -- state 2 : waiting ',' or ']'.
	 -- state 3 : end.
      do
	 if a_base_type then
	    last_class_type := last_base_type;
	    Result := true;
	 elseif a_base_class_name then
	    from
	       Result := true;
	       base_class_name := last_class_name;
	    until
	       state > 2
	    loop
	       inspect
		  state
	       when 0 then
		  if skip1('[') then
		     state := 1;
		  else
		     !TYPE_CLASS!last_class_type.make(base_class_name);
		     state := 3;
		  end;
	       when 1 then
		  if a_type then
		     if generic_list = Void then
			!!generic_list.with_capacity(2,1);
		     end;
		     generic_list.add_last(last_type);
		     state := 2;
		  elseif cc = ',' then
		     wcp(em12);
		     ok := skip1(',');
		  elseif cc = ']' then
		     state := 2;
		  else
		     fcp(em16);
		     state := 2;
		  end;
	       else -- state = 2
		  if skip1(',') then
		     state := 1;
		  elseif cc = ']' then
		     if generic_list = Void then
			wcp("Empty generic list (deleted).");
			!TYPE_CLASS!last_class_type.make(base_class_name);
		     else
			!TYPE_GENERIC!last_class_type.make(base_class_name,generic_list);
		     end;
		     ok := skip1(']');
		     state := 3;
		  elseif a_type then
		     if generic_list = Void then
			!!generic_list.with_capacity(2,1);
		     end;
		     generic_list.add_last(last_type);
		     warning(last_type.start_position,em5);
		  else
		     fcp("Bad generic list.");
		     state := 3;
		  end;
	       end;
	    end;
	 end;
      end;

   a_clients: CLIENT_LIST is
	 --++ clients -> "{" { base_class_name "," ... } "}"
	 --++
      local
	 sp: POSITION;
	 list: CLASS_NAME_LIST;
	 state: INTEGER;
	 -- state 0 : waiting a base_class_name or "}" if empty list.
	 -- state 1 : waiting a base_class_name after a ",".
	 -- state 2 : waiting "," or "}" to end list.
	 -- state 3 : error.
	 -- state 4 : end.
      do
	 if skip1('{') then
	    from
	       sp := pos(start_line,start_column);
	    until
	       state > 3
	    loop
	       inspect
		  state
	       when 0 then
		  if a_base_class_name then
		     !!list.make_1(last_class_name);
		     state := 2;
		  elseif skip1('}') then
		     state := 4;
		  elseif cc = ',' then
		     wcp(em7);
		     ok := skip1(',');
		  else
		     state := 3;
		  end;
	       when 1 then
		  if a_base_class_name then
		     list.add_last(last_class_name);
		     state := 2;
		  elseif cc = ',' then
		     wcp(em7);
		     ok := skip1(',');
		  elseif cc = '}' then
		     wcp("Unexpected bracket.");
		     ok := skip1('}');
		     state := 4;
		  else
		     state := 3;
		  end;
	       when 2 then
		  if skip1(',') then
		     state := 1;
		  elseif skip1('}') then
		     state := 4;
		  elseif a_base_class_name then
		     warning(last_class_name.start_position,em5);
		     list.add_last(last_class_name);
		  else
		     state := 3;
		  end;
	       else -- state = 3
		  fcp(em11);
		  state := 4;
	       end;
	    end;
	    !!Result.make(sp,list);
	 else
	    !!Result.omitted;
	 end;
      ensure
	 Result /= Void
      end;

   a_compound1: COMPOUND is
	 --++ compound -> {instruction ";" ...}
	 --++
      local
	 hc: COMMENT;
	 instruction, first_one: INSTRUCTION;
	 remainder: FIXED_ARRAY[INSTRUCTION];
      do
	 from
	    hc := get_comment;
	    from
	    until
	       cc /= ';'
	    loop
	       wcp(em24);
	       ok := skip1(';');
	    end;
	 until
	    not a_instruction or else nb_errors > 0
	 loop
	    instruction := last_instruction;
	    check
	       instruction /= Void;
	    end;
	    if cc = '(' then
	       wcp(em6);
	    end;
	    from
	       ok := skip1(';');
	    until
	       cc /= ';'
	    loop
	       wcp(em24);
	       ok := skip1(';');
	    end;
	    if nb_errors = 0 then
	       instruction := instruction.add_comment(get_comment);
	       if first_one = Void then
		  first_one := instruction;
	       else
		  if remainder = Void then
		     !!remainder.with_capacity(4);
		  end;
		  remainder.add_last(instruction);
	       end;
	    end;
	 end;
	 if hc /= Void or else first_one /= Void then
	    !!Result.make(hc,first_one,remainder);
	 end;
      end;

   a_compound2(compound_of, terminator: STRING): COMPOUND is
	 -- Like a_compound1 but stop when `terminator' is encountered.
      local
	 hc: COMMENT;
	 instruction, first_one: INSTRUCTION;
	 remainder: FIXED_ARRAY[INSTRUCTION];
      do
	 from
	    hc := get_comment;
	    from
	    until
	       cc /= ';'
	    loop
	       wcp(em24);
	       ok := skip1(';');
	    end;
	 until
	    not a_instruction or else nb_errors > 0
	 loop
	    instruction := last_instruction;
	    check
	       instruction /= Void;
	    end;
	    if cc = '(' then
	       wcp(em6);
	    end;
	    from
	       ok := skip1(';');
	    until
	       cc /= ';'
	    loop
	       wcp(em24);
	       ok := skip1(';');
	    end;
	    if nb_errors = 0 then
	       instruction := instruction.add_comment(get_comment);
	       if first_one = Void then
		  first_one := instruction;
	       else
		  if remainder = Void then
		     !!remainder.with_capacity(4);
		  end;
		  remainder.add_last(instruction);
	       end;
	    end;
	 end;
	 if not a_keyword(terminator) then
	    eh.append("In compound (");
	    eh.append(compound_of);
	    eh.append("). Instruction or keyword %"");
	    eh.append(terminator);
	    fcp("%" expected.");
	 end;
	 if hc /= Void or else first_one /= Void then
	    !!Result.make(hc,first_one,remainder);
	 end;
      end;

   a_conditional: BOOLEAN is
	 --++ conditional -> "if" then_part_list ["else" compound] "end"
	 --++
      local
	 ifthenelse: IFTHENELSE;
      do
	 if a_keyword(fz_if) then
	    Result := true;
	    !!ifthenelse.make(pos(start_line,start_column));
	    a_then_part_list(ifthenelse);
	    if a_keyword(fz_else) then
	       ifthenelse.set_else_compound(a_compound2("else part",fz_end));
	    else
	       if not a_keyword(fz_end) then
		  wcp("Keyword %"end%" added.");
	       end;
	    end;
	    last_instruction := ifthenelse;
	 end;
      end;

   a_creation: BOOLEAN is
	 --++ creation -> "!"[type]"!" writable ["." procedure_name [actuals]]
	 --++
      local
	 sp: POSITION;
	 type: TYPE;
	 writable: EXPRESSION;
	 procedure_name: SIMPLE_FEATURE_NAME;
	 call: PROC_CALL;
      do
	 if skip1('!') then
	    Result := true;
	    sp := pos(start_line,start_column);
	    if a_type then
	       type := last_type;
	       if type.is_anchored then
		  warning(type.start_position,em20);
	       end;
	       if not skip1('!') then
		  fcp("Bad creation instruction ('!' expected).");
	       end;
	    elseif skip1('!') then
	    else
	       fcp("Bad creation instruction (type or '!' expected).");
	    end;
	    writable := mandatory_writable;
	    if skip1('.') then
	       if a_identifier then
		  procedure_name := tmp_name.to_simple_feature_name;
		  if cc = '(' then
		     call := to_proc_call(writable,procedure_name,a_actuals);
		  else
		     !PROC_CALL_0!call.make(writable,procedure_name);
		  end;
	       else
		  fcp(em23);
	       end;
	    end;
	    if type = Void and then call = Void then
	       !CREATION_CALL_1!last_instruction.make(sp,writable);
	    elseif type /= Void and then call = Void then
	       !CREATION_CALL_2!last_instruction.make(sp,type,writable);
	    elseif type = Void and then call /= Void then
	       !CREATION_CALL_3!last_instruction.make(sp,writable,call);
	    else
	       !CREATION_CALL_4!last_instruction.make(sp,type,writable,call);
	    end;
	 end;
      end;

   a_create_instruction: BOOLEAN is
	 --++ create -> ["{" type "}"] writable ["." procedure_name [actuals]]
	 --++
	 -- Note: this is only syntactic sugar to accept this new 
	 -- notation (which is by now pretty_printed in the good old 
	 -- notation ;-).
      local
	 sp: POSITION;
	 type: TYPE;
	 writable: EXPRESSION;
	 procedure_name: SIMPLE_FEATURE_NAME;
	 call: PROC_CALL;
      do
	 if a_keyword(fz_create) then
	    Result := true;
	    sp := pos(start_line,start_column);
-- ***
--	    eh.add_position(sp);
--	    eh.append("New create instruction used (temporary warning %
--                      %because this new syntax may be ambigous).");
--	    eh.print_as_warning;
-- ***
	    if skip1('{') then
	       if a_type then
		  type := last_type;
		  if type.is_anchored then
		     warning(type.start_position,em20);
		  end;
		  if not skip1('}') then
		     fcp("Bad create instruction ('}' expected).");
		  end;
	       else
		  fcp("Bad create instruction (type expected).");
	       end;
	    end;
	    writable := mandatory_writable;
	    if skip1('.') then
	       if a_identifier then
		  procedure_name := tmp_name.to_simple_feature_name;
		  if cc = '(' then
		     call := to_proc_call(writable,procedure_name,a_actuals);
		  else
		     !PROC_CALL_0!call.make(writable,procedure_name);
		  end;
	       end;
	    end;
	    if type = Void and then call = Void then
	       !CREATION_CALL_1!last_instruction.make(sp,writable);
	    elseif type /= Void and then call = Void then
	       !CREATION_CALL_2!last_instruction.make(sp,type,writable);
	    elseif type = Void and then call /= Void then
	       !CREATION_CALL_3!last_instruction.make(sp,writable,call);
	    else
	       !CREATION_CALL_4!last_instruction.make(sp,type,writable,call);
	    end;
	 end;
      end;
   
   a_creation_clause(sp: POSITION) is
	 --++ creation_clause -> [clients] [comment] feature_list
	 --++
      local
	 clients: CLIENT_LIST;
	 comments: COMMENT;
	 creation_clause: CREATION_CLAUSE;
      do
	 clients := a_clients;
	 comments := get_comment;
	 if a_feature_name_list then
	 end;
	 !!creation_clause.make(sp,clients,comments,last_feature_name_list);
	 last_base_class.add_creation_clause(creation_clause);
      end;

   a_debug: BOOLEAN is
	 --++ debug -> "debug" "(" {manifest_string "," ...} ")"
	 --++                  compound "end"
	 --++
      local
	 sp: POSITION;
	 list: FIXED_ARRAY[MANIFEST_STRING];
	 e_debug: E_DEBUG;
      do
	 if a_keyword(fz_debug) then
	    sp := pos(start_line,start_column);
	    if skip1('(') then
	       from
	       until
		  not a_manifest_string
	       loop
		  if list = Void then
		     !!list.with_capacity(4);
		  end;
		  list.add_last(last_manifest_string);
		  ok := skip1(',');
	       end;
	       if list = Void then
		  wcp("Empty debug key list (deleted).");
	       end;
	       if not skip1(')') then
		  fcp("%")%" expected to end debug string list.");
	       end;
	    end;
	    Result := true;
	    !!e_debug.make(sp,list,a_compound2("debug",fz_end));
	    last_instruction := e_debug;
	    end;
	 end;

   a_expression: BOOLEAN is
	 --++ expression -> "<<" {Expression "," ...} ">>" |
         --++               "[" {Expression "," ...} "]" |
	 --++               Void |
	 --++               e0
	 --++
      local
	 sp: POSITION;
	 list: FIXED_ARRAY[EXPRESSION];
      do
	 if skip2('<','<') then
	    from
	       Result := true;
	       sp := pos(start_line,start_column);
	    until
	       not a_expression
	    loop
	       if list = Void then
		  !!list.with_capacity(4);
	       end;
	       list.add_last(last_expression);
	       ok := skip1(',');
	    end;
	    if not skip2('>','>') then
	       fcp("End of manifest array expected.");
	    end;
	    !MANIFEST_ARRAY!last_expression.make(sp,list);
	 elseif skip1('[') then
	    from
	       Result := true;
	       sp := pos(start_line,start_column);
	    until
	       not a_expression
	    loop
	       if list = Void then
		  !!list.with_capacity(4);
	       end;
	       list.add_last(last_expression);
	       ok := skip1(',');
	    end;
	    if not skip1(']') then
	       fcp("End of TUPLE expression expected.");
	    end;
	    !TUPLE_EXPRESSION!last_expression.make(sp,list);
	 else
	    Result := a_e0;
	 end;
      end;

   a_e0: BOOLEAN is
	 --++ e0 -> e1 r1
	 --++
      do
	 Result := a_e1;
	 if Result then
	    a_r1(last_expression);
	 end;
      end;

   a_e1: BOOLEAN is
	 --++ e1 -> e2 r2
	 --++
      do
	 Result := a_e2;
	 if Result then
	    a_r2(last_expression);
	 end;
      end;

   a_e2: BOOLEAN is
	 --++ e2 -> e3 r3
	 --++
      do
	 Result := a_e3;
	 if Result then
	    a_r3(last_expression);
	 end;
      end;

   a_e3: BOOLEAN is
	 --++ e3 -> e4 r4
	 --++
      do
	 Result := a_e4;
	 if Result then
	    a_r4(last_expression);
	 end;
      end;

   a_e4: BOOLEAN is
	 --++ e4 -> e5 r5
	 --++
      do
	 Result := a_e5;
	 if Result then
	    a_r5(last_expression);
	 end;
      end;

   a_e5: BOOLEAN is
	 --++ e5 -> e6 r6
	 --++
      do
	 Result := a_e6;
	 if Result then
	    a_r6(last_expression);
	 end;
      end;

   a_e6: BOOLEAN is
	 --++ e6 -> e7 r7
	 --++
      do
	 Result := a_e7;
	 if Result then
	    a_r7(last_expression);
	 end;
      end;

   a_e7: BOOLEAN is
	 --++ e7 -> e8 r8
	 --++
      do
	 Result := a_e8;
	 if Result then
	    a_r8(last_expression);
	 end;
      end;

   a_e8: BOOLEAN is
	 --++ e8 -> "not" e8 |
	 --++       "+" e8 |
	 --++       "-" e8 |
	 --++       free_operator e8 !
	 --++       e9
	 --++
      local
	 op: PREFIX_NAME;
	 prefix_freeop: CALL_PREFIX_FREEOP;
	 sp: POSITION;
      do
	 if a_keyword(as_not) then
	    sp := pos(start_line,start_column);
	    if a_e8 then
	       !CALL_PREFIX_NOT!last_expression.make(sp,last_expression);
	       Result := true;
	    else
	       err_exp(sp,as_not);
	    end;
	 elseif skip1('+') then
	    sp := pos(start_line,start_column);
	    if a_e8 then
	       !CALL_PREFIX_PLUS!last_expression.make(sp,last_expression);
	       Result := true;
	    else
	       err_exp(sp,"+ (prefix)");
	    end;
	 elseif skip1('-') then
	    sp := pos(start_line,start_column);
	    if a_e8 then
	       !CALL_PREFIX_MINUS!last_expression.make(sp,last_expression);
	       Result := true;
	    else
	       err_exp(sp,"- (prefix)");
	    end;
	 elseif a_free_operator then
	    op := tmp_name.to_prefix_name;
	    if a_e8 then
	       !!prefix_freeop.make(last_expression,op);
	       last_expression := prefix_freeop;
	       Result := true;
	    else
	       eh.append("Bad use of prefix operator. ");
	       err_exp(op.start_position,op.to_string);
	    end;
	 else
	    Result := a_e9;
	 end;
      end;

   a_e9: BOOLEAN is
	 --++ e9 -> e10 |
	 --++       "old" e10
	 --++
      do
	 if a_keyword(fz_old) then
	    if not in_ensure then
	       error(pos(start_line,start_column),
		     "Expression %"old%" can be used in ensure clause %
				       %only (VAOL.1).");
	    end;
	    if a_e10 then
	       !E_OLD!last_expression.make(last_expression);
	       Result := true;
	    else
	       fcp("Expression expected after %"old%".");
	    end;
	 else
	    Result := a_e10;
	 end;
      end;

   a_e10: BOOLEAN is
	 --++ e10 -> strip |
	 --++       "(" expression ")" r10 |
	 --++       manifest_constant |
	 --++       precursor_call |
	 --++       "Result" r10 |
	 --++       "Current" r10 |
	 --++       "Void" r10 |
	 --++       local_variable r10 |
	 --++       argument r10 |
	 --++       function_call r10 |
	 --++
      do
	 if a_strip then
	    Result := true;
	 elseif skip1('(') then
	    Result := true;
	    if a_expression then
	       if skip1(')') then
		  a_r10(false,last_expression,Void,Void);
	       else
		  fcp("')' expected in expression.")
	       end;
	    else
	       fcp("Expression expected.")
	    end;
	 elseif a_manifest_constant then
	    last_expression := last_manifest_constant;
	    Result := true;
	    if skip1('.') then
	       wcp("Added brackets for manifest constant before dot.");
	       a_after_a_dot(false,last_expression);
	    end;
	 elseif a_precursor(false) then
	    Result := true;
	 elseif a_identifier then
	    Result := true;
	    if a_result or else a_current or else a_void or else
	       a_local_variable or else a_argument then
	       a_r10(false,last_expression,Void,Void);
	    else
	       a_function_call;
	    end;
	 end;
      end;

   a_external: ROUTINE is
	 --++ external -> "<external-specification>" external_name
	 --++
      local
	 tag: STRING;
	 l: NATIVE;
      do
	 if not skip1('%"') then
	    fcp(em18);
	 end;
	 from
	    !!tag.make(24);
	 until
	    cc = '%"'
	 loop
	    if cc = '%%' then
	       next_char;
	    end;
	    tag.extend(cc);
	    next_char;
	 end;
	 if ("SmallEiffel").is_equal(tag) then
	    !NATIVE_SMALL_EIFFEL!l.make(tag);
	 elseif ("compiler built-in").is_equal(tag) then
	    !NATIVE_SMALL_EIFFEL!l.make(tag);
	 elseif ("C_WithCurrent").is_equal(tag) then
	    !NATIVE_WITH_CURRENT!l.make(tag);
	 elseif ("C_InlineWithCurrent").is_equal(tag) then
	    !NATIVE_INLINE_WITH_CURRENT!l.make(tag);
	 elseif ("C_WithoutCurrent").is_equal(tag) then
	    !NATIVE_WITHOUT_CURRENT!l.make(tag);
	 elseif ("C_InlineWithoutCurrent").is_equal(tag) then
	    !NATIVE_INLINE_WITHOUT_CURRENT!l.make(tag);
	 elseif ("CSE").is_equal(tag) then
	    !NATIVE_SMALL_EIFFEL!l.make(tag);
	    wcpefnc("CSE",fz_se);
	 elseif ("CWC").is_equal(tag) then
	    -- To be compatible with Visual Eiffel.
	    !NATIVE_WITH_CURRENT!l.make(tag);
	 elseif ("ICWC").is_equal(tag) then
	    !NATIVE_INLINE_WITH_CURRENT!l.make(tag);
	    wcpefnc("ICWC","C_InlineWithCurrent");
	 elseif ("IC").is_equal(tag) then
	    !NATIVE_INLINE_WITHOUT_CURRENT!l.make(tag);
	    wcpefnc("IC","C_InlineWithoutCurrent");
	 elseif ("JVM_invokestatic").is_equal(tag) then
	    !NATIVE_JVM_INVOKESTATIC!l.make(tag);
	 elseif ("JVM_invokevirtual").is_equal(tag) then
	    !NATIVE_JVM_INVOKEVIRTUAL!l.make(tag);
	 elseif tag.has_prefix("C++") then
	    !NATIVE_C_PLUS_PLUS!l.make(tag);
	 elseif tag.has_prefix("C") then
	    !NATIVE_WITHOUT_CURRENT!l.make(tag);
	 else
	    fcp("Unkown external specification.");
	 end;
	 if not skip1('%"') then
	    fcp(em18);
	 end;
	 Result := tmp_feature.to_external_routine(l,a_alias);
      end;

   a_alias: STRING is
	 --++ external_name -> ["alias" manifest_string]
	 --++
      do
	 if a_keyword(fz_alias) then
	    if not skip1('%"') then
	       fcp(em19);
	    end;
	    from
	       !!Result.make(24);
	    until
	       cc = '%"'
	    loop
	       Result.extend(cc);
	       next_char;
	    end;
	    if not skip1('%"') then
	       fcp(em19);
	    end;
	 end;
      end;

   a_feature_name_list: BOOLEAN is
	 --++ feature_name_list -> {feature_name "," ...}
	 --++
	 --
	 -- Gives true when list is not empty.
      local
	 state: INTEGER;
	 -- state 0 : nothing read.
	 -- state 1 : feature name read.
	 -- state 2 : separator read.
	 -- state 3 : end.
      do
	 from
	    last_feature_name_list := Void;
	 until
	    state >= 3
	 loop
	    inspect
	       state
	    when 0 then
	       if a_feature_name then
		  !!last_feature_name_list.make_1(last_feature_name);
		  Result := true;
		  state := 1;
	       elseif cc = ',' then
		  wcp(em7);
		  ok := skip1(',');
	       else
		  state := 3
	       end;
	    when 1 then
	       if cc = ',' then
		  ok := skip1(',');
		  state := 2;
	       elseif a_feature_name then
		  warning(last_feature_name.start_position,em5);
		  last_feature_name_list.add_last(last_feature_name);
	       else
		  state := 3;
	       end;
	    when 2 then
	       if a_feature_name then
		  last_feature_name_list.add_last(last_feature_name);
		  state := 1;
	       elseif cc = ',' then
		  wcp(em12);
		  ok := skip1(',');
	       else
		  ecp(em2);
		  state := 3;
	       end;
	    end;
	 end;
      end;

   a_feature_name: BOOLEAN is
	 --++ feature_name -> prefix |
	 --++                 infix |
	 --++                 simple_feature_name
	 --++
      do
	 if a_prefix then
	    last_feature_name := last_prefix;
	    Result := true;
	 elseif a_infix then
	    last_feature_name := last_infix;
	    Result := true;
	 elseif a_identifier then
	    last_feature_name := tmp_name.to_simple_feature_name;
	    Result := true;
	 end;
      end;

   a_feature_clause is
	 --++ feature_clause -> [clients] [comment] feature_declaration_list
	 --++
      local
	 feature_clause: FEATURE_CLAUSE;
	 clients: CLIENT_LIST;
	 comment: COMMENT;
      do
	 from
	    clients := a_clients;
	    comment := get_comment;
	    faof.clear;
	 until
	    not a_feature_declaration
	 loop
	    ok := skip1(';');
	    if last_feature_declaration /= Void then
	       faof.add_last(last_feature_declaration);
	       last_feature_declaration.set_header_comment(get_comment);
	    end;
	 end;
	 if not faof.is_empty then
	    !!feature_clause.make(clients,comment,faof.twin);
	    last_base_class.add_feature_clause(feature_clause);
	 elseif comment /= Void then
	    !!feature_clause.make(clients,comment,Void);
	    last_base_class.add_feature_clause(feature_clause);
	 end;
      end;

   a_feature_declaration: BOOLEAN is
	 --++ feature_declaration -> {["frozen"] feature_name "," ...}+
	 --++                        formal_arg_list
	 --++                        [":" type]
	 --++                        ["is" "unique" |
	 --++                         "is" manifest_constant |
	 --++                         "is" routine]
	 --++
      do
	 from
	    tmp_feature.initialize;
	    if a_keyword(fz_frozen) then
	       if a_feature_name then
		  Result := true;
		  to_frozen_feature_name;
		  tmp_feature.add_synonym(last_feature_name);
	       else
		  fcp(em2);
	       end;
	    elseif a_feature_name then
	       Result := true;
	       tmp_feature.add_synonym(last_feature_name);
	    end;
	 until
	    not skip1(',')
	 loop
	    if a_keyword(fz_frozen) then
	       if a_feature_name then
		  to_frozen_feature_name;
		  tmp_feature.add_synonym(last_feature_name);
	       else
		  fcp("Frozen feature name synonym expected.");
	       end;
	    elseif a_feature_name then
	       tmp_feature.add_synonym(last_feature_name);
	    else
	       ecp("Synonym feature name expected.");
	    end;
	 end;
	 if Result then
	    a_formal_arg_list;
	    if skip1(':') then
	       if a_type then
		  inside_function := true;
		  tmp_feature.set_type(last_type);
	       else
		  fcp(em16);
	       end;
	    else
	       inside_function := false;
	    end;
	    if a_keyword(fz_is) then
	       if a_keyword(fz_unique) then
		  last_feature_declaration := tmp_feature.to_cst_att_unique;
	       elseif a_boolean_constant then
		  last_feature_declaration :=
		     tmp_feature.to_cst_att_boolean(last_boolean_constant);
	       elseif a_character_constant then
		  last_feature_declaration :=
		     tmp_feature.to_cst_att_character(last_character_constant);
	       elseif a_manifest_string then
		  last_feature_declaration :=
		     tmp_feature.to_cst_att_string(last_manifest_string);
	       elseif a_bit_constant then
		  last_feature_declaration :=
		     tmp_feature.to_cst_att_bit(last_bit_constant);
	       elseif a_real_constant then
		  last_feature_declaration :=
		     tmp_feature.to_cst_att_real(last_real_constant);
	       elseif a_integer_constant then
		  last_feature_declaration :=
		     tmp_feature.to_cst_att_integer(last_integer_constant);
	       else
		  last_feature_declaration := a_routine;
	       end;
	    else
	       last_feature_declaration := tmp_feature.to_writable_attribute;
	    end;
	    inside_function := false;
	    inside_once_function := false;
	    arguments := Void;
	 end;
      end;

   a_formal_generic_list is
	 --++ formal_generic_list -> ["[" {formal_generic "," ...} "]"]
	 --++ formal_generic -> base_class_name ["->" class_type]
	 --++
      local
	 fga: FORMAL_GENERIC_ARG;
	 formal_generic_name: CLASS_NAME;
	 constraint: TYPE;
	 state: INTEGER;
	 -- state 0 : waiting for a `formal_generic_name'.
	 -- state 1 : waiting for "->" or "," or "]".
	 -- state 2 : waiting for "," or "]".
	 -- state 3 : waiting for a `constraint' type.
	 -- state 4 : end.
	 -- state 5 : error.
      do
	 formal_generic_list := Void;
	 if skip1('[') then
	    from
	       !!formal_generic_list.make(pos(start_line,start_column));
	       last_base_class.set_formal_generic_list(formal_generic_list);
	    until
	       state > 3
	    loop
	       inspect
		  state
	       when 0 then
		  if a_base_class_name then
		     formal_generic_name := last_class_name;
		     state := 1;
		  else
		     state := 5;
		  end;
	       when 1 then
		  if skip2('-','>') then
		     state := 3;
		  elseif cc = ',' or else cc = ']' then
		     !!fga.make(formal_generic_name,constraint);
		     constraint := Void;
		     formal_generic_list.add_last(fga);
		     inspect
			cc
		     when ',' then state := 0;
		     when ']' then state := 4;
		     end;
		     ok := skip1(cc);
		  else
		     state := 5;
		  end;
	       when 2 then
		  if cc = ',' or else cc = ']' then
		     !!fga.make(formal_generic_name,constraint);
		     constraint := Void;
		     formal_generic_list.add_last(fga);
		     inspect
			cc
		     when ',' then state := 0;
		     when ']' then state := 4;
		     end;
		     ok := skip1(cc);
		  else
		     state := 5;
		  end;
	       when 3 then
		  if a_type_formal_generic then
		     constraint := last_type_formal_generic;
		     state := 2;
		  elseif a_class_type then
		     constraint := last_class_type;
		     state := 2;
		  else
		     fcp("Constraint Class name expected.");
		     state := 5;
		  end;
	       end;
	    end;
	    inspect
	       state
	    when 4 then
	       if formal_generic_list.count = 0 then
		  eh.add_position(formal_generic_list.start_position);
		  eh.append("Empty formal generic list (deleted).");
		  eh.print_as_warning;
		  formal_generic_list := Void;
		  last_base_class.set_formal_generic_list(Void);
	       end;
	    when 5 then
	       check nb_errors > 0 end;
	    end;
	 end;
      end;

   a_function_call is
	 --++ function_call -> [actuals] r10 |
	 --++                   ^
	 --++
      local
	 sfn: SIMPLE_FEATURE_NAME;
	 implicit_current: IMPLICIT_CURRENT;
      do
	 sfn := tmp_name.to_simple_feature_name;
	 !!implicit_current.make(sfn.start_position);
	 a_r10(false,implicit_current,sfn,a_actuals);
      end;

   a_index_clause: BOOLEAN is
	 --++ index_clause -> [identifier ":"] {index_value "," ...}+
	 --++
      local
	 index_clause: INDEX_CLAUSE;
      do
	 if a_identifier then
	    Result := true;
	    if skip1(':') then
	       !!index_clause.with_tag(tmp_name.aliased_string);
	       if a_index_value then
		  index_clause.add_last(last_index_value);
	       else
		  fcp(em3);
	       end;
	    else
	       !!index_clause.without_tag(tmp_name.to_simple_feature_name);
	    end;
	 elseif a_manifest_constant then
	    Result := true;
	    !!index_clause.without_tag(last_manifest_constant);
	 end;
	 if Result then
	    from
	    until
	       not skip1(',')
	    loop
	       if a_index_value then
		  index_clause.add_last(last_index_value);
	       else
		  fcp(em3);
	       end;
	    end;
	    last_base_class.add_index_clause(index_clause);
	 end;
      end;

   a_index_value: BOOLEAN is
	 --++ index_value -> identifier | manifest_constant
	 --++
      do
	 if a_identifier then
	    last_index_value := tmp_name.to_simple_feature_name;
	    Result := true;
	 elseif a_manifest_constant then
	    last_index_value := last_manifest_constant;
	    Result := true;
	 end;
      end;

   a_indexing is
	 --++ indexing -> "indexing" {index_clause ";" ...}
	 --++
      do
	 if a_keyword(fz_indexing) then
	    from
	    until
	       not a_index_clause
	    loop
	       ok := skip1(';');
	    end;
	 end;
      end;

   a_infix: BOOLEAN is
	 --++ infix -> "infix" "%"" binary "%""
	 --++          "infix" "%"" free_operator "%""
	 --++
      local
	 sp: POSITION;
      do
	 if a_keyword(fz_infix) then
	    Result := true;
	    sp := pos(start_line,start_column);
	    if cc = '%"' then
	       next_char;
	    else
	       wcp("Character '%%%"' inserted after %"infix%".");
	    end;
	    if a_binary(sp) then
	       last_infix := last_binary;
	    elseif a_free_operator then
	       last_infix := tmp_name.to_infix_name(sp);
	    else
	       fcp("Infix operator name expected.");
	    end;
	    if not skip1('%"') then
	       wcp("Character '%%%"' inserted.");
	    end;
	 end;
      end;

   a_inspect: BOOLEAN is
	 --++ inspect -> "inspect" expression
	 --++            {when_part ...}
	 --++            ["else" compound]
	 --++            "end"
	 --++
      local
	 sp, spec: POSITION;
	 i: E_INSPECT;
	 ec: COMPOUND;
      do
	 if a_keyword(fz_inspect) then
	    Result := true;
	    sp := pos(start_line,start_column);
	    if a_expression then
	       last_expression := last_expression.add_comment(get_comment);
	    else
	       fcp("Expression expected (%"inspect ... %").");
	    end;
	    from
	       !!i.make(sp,last_expression);
	    until
	       not a_when_part(i)
	    loop
	    end;
	    if a_keyword(fz_else) then
	       spec := pos(start_line,start_column);
	       ec := a_compound2("else of inspect",fz_end);
	       i.set_else_compound(spec,ec);
	    elseif not a_keyword(fz_end) then
	       wcp("Added %"end%" for inspect instruction.");
	    end;
	    last_instruction := i;
	 end;
      end;

   a_instruction: BOOLEAN is
	 --++ instruction -> check | debug | conditionnal | retry |
	 --++                inspect | loop | creation | assignment_or_call
	 --++
      do
	 Result := true;
	 if a_check then
	 elseif a_debug then
	 elseif a_conditional then
	 elseif a_retry then
	 elseif a_inspect then
	 elseif a_loop then
	 elseif a_create_instruction then
	 elseif a_assignment_or_call then
	 elseif a_creation then
	 else
	    Result := false;
	 end;
      end;

   a_integer_constant: BOOLEAN is
	 --++ integer_constant -> ["+" | "-"] integer
	 --++
      do
	 if skip1('+') then
	    if a_integer then
	       Result := true;
	    else
	       fcp(fz_iinaiv);
	    end;
	 elseif skip1('-') then
	    if a_integer then
	       last_integer_constant.unary_minus;
	       Result := true;
	    else
	       fcp(fz_iinaiv);
	    end;
	 else
	    Result := a_integer;
	 end;
      end;

   a_loop: BOOLEAN is
	 --++ loop -> "from" compound
	 --++         ["invariant"] assertion
	 --++         ["variant" [identifier ":"] expression]
	 --++         "until" expression
	 --++         "loop" compound
	 --++         "end"
	 --++
      local
	 l1, c1, l2, c2: INTEGER;
	 e_loop: E_LOOP;
	 i: COMPOUND;
	 ic: LOOP_INVARIANT;
	 vc: LOOP_VARIANT;
	 ue: EXPRESSION;
	 lb: COMPOUND;
	 hc: COMMENT;
	 al: ARRAY[ASSERTION];
      do
	 if a_keyword(fz_from) then
	    Result := true;
	    l1 := start_line;
	    c1 := start_column;
	    i := a_compound1;
	    if a_keyword(fz_invariant) then
	       l2 := start_line;
	       c2 := start_column;
	       hc := get_comment;
	       al := a_assertion;
	       if hc /= Void or else al /= Void then
		  !!ic.make(pos(l2,c2),hc,al);
	       end;
	    end;
	    if a_keyword(fz_variant) then
	       if a_tag_mark and then a_expression then
		  !LOOP_VARIANT_2!vc.make(last_tag_mark,last_expression,
					  get_comment);
	       elseif a_expression then
		  !LOOP_VARIANT_1!vc.make(last_expression,get_comment);
	       else
		  wcp("Variant (INTEGER) Expression Expected.");
	       end;
	    end;
	    if a_keyword(fz_until) then
	       if a_expression then
		  ue := last_expression.add_comment(get_comment);
	       else
		  fcp("Boolean expression expected (until).");
		  ue := last_expression;
	       end;
	    else
	       fcp("Keyword %"until%" expected (in a loop).");
	       ue := last_expression;
	    end;
	    if cc = ';' then
	       wcp(em24);
	       ok := skip1(';');
	    end;
	    if not a_keyword(fz_loop) then
	       wcp("Keyword %"loop%" expected (in a loop).");
	    end;
	    lb := a_compound2("loop body",fz_end);
	    !!e_loop.make(pos(l1,c1),i,ic,vc,ue,lb);
	    last_instruction := e_loop;
	 end;
      end;

   a_manifest_constant: BOOLEAN is
	 --++ manifest_constant -> boolean_constant | character_constant |
	 --++                      real_constant | integer_constant |
	 --++                      manifest_string | bit_constant
	 --++
      do
	 if a_boolean_constant then
	    last_manifest_constant := last_boolean_constant;
	    Result := true;
	 elseif a_character_constant then
	    last_manifest_constant := last_character_constant;
	    Result := true;
	 elseif a_manifest_string then
	    last_manifest_constant := last_manifest_string;
	    Result := true;
	 elseif a_bit_constant then
	    last_manifest_constant := last_bit_constant;
	    Result := true;
	 elseif a_real_constant then
	    last_manifest_constant := last_real_constant;
	    Result := true;
	 elseif a_integer_constant then
	    last_manifest_constant := last_integer_constant;
	    Result := true;
	 end;
      end;

   a_new_export_list is
	 --++ new_export_list -> ["export" {new_export_item ";" ...}]
	 --++ new_export_item -> clients "all" |
	 --++                    clients feature_list
	 --++
      local
	 export_list: EXPORT_LIST;
	 sp: POSITION;
	 clients: CLIENT_LIST;
	 items: ARRAY[EXPORT_ITEM];
	 new_export_item: EXPORT_ITEM;
	 state: INTEGER;
	 -- state 0 : waiting for a `clients'.
	 -- state 1 : `clients' read.
	 -- state 2 : waiting ";" before next one.
	 -- state 3 : error.
	 -- state 4 : end.
	 --
      do
	 if a_keyword(fz_export) then
	    from
	       sp := pos(start_line,start_column);
	    until
	       state > 3
	    loop
	       inspect
		  state
	       when 0 then
		  if cc = '{' then
		     clients := a_clients;
		     state := 1;
		  elseif cc = ';' then
		     wcp(em24);
		     ok := skip1(';');
		  else
		     if items /= Void then
			!!export_list.make(sp,items);
			last_parent.set_export(export_list);
		     end;
		     state := 4;
		  end;
	       when 1 then
		  if a_keyword(fz_all) then
		     !!new_export_item.make_all(clients);
		     if items = Void then
			!!items.with_capacity(2,1);
		     end;
		     items.add_last(new_export_item);
		     state := 2;
		  else
		     if a_feature_name_list then
			!!new_export_item.make(clients,last_feature_name_list);
			if items = Void then
			   !!items.with_capacity(2,1);
			end;
			items.add_last(new_export_item);
			state := 2;
		     else
			state := 3;
		     end;
		  end;
	       when 2 then
		  if skip1(';') then
		     state := 0;
		  elseif cc = '{' then
		     wcp(em6);
		     state := 0;
		  else
		     if items /= Void then
			!!export_list.make(sp,items);
			last_parent.set_export(export_list);
		     end;
		     state := 4;
		  end;
	       else -- state = 3
		  fcp(em11);
		  state := 4;
	       end;
	    end;
	 end;
      end;

   a_parent_list(sp: POSITION; hc: COMMENT) is
	 --++ parent_list -> {parent ";" ...}
	 --++
      local
	 list: FIXED_ARRAY[PARENT];
      do
	 from
	 until
	    not a_parent
	 loop
	    if list = Void then
	       !!list.with_capacity(4);
	    end;
	    list.add_last(last_parent);
	    ok := skip1(';');
	    last_parent.set_comment(get_comment);
	 end;
	 if hc /= Void or else list /= Void then
	    if list = Void then
	       if last_base_class.heading_comment2 = Void then
		  last_base_class.set_heading_comment2(hc);
	       else
		  last_base_class.heading_comment2.append(hc);
	       end;
	    else
	       last_base_class.set_parent_list(sp,hc,list);
	    end;
	 end;
      end;

   a_parent: BOOLEAN is
	 --++ parent -> class_type
	 --++           ["rename" rename_list]
	 --++           new_export_list
	 --++           ["undefine" feature_name_list]
	 --++           ["redefine" feature_name_list]
	 --++           ["select" feature_name_list]
	 --++           ["end"]
	 --++
      do
	 if a_class_type then
	    Result := true;
	    !!last_parent.make(last_class_type);
	    if a_keyword(fz_rename) then
	       a_rename_list;
	       if cc = ';' then
		  wcp("Unexpected %";%" to end rename list.");
		  ok := skip1(';');
	       end;
	    end;
	    a_new_export_list;
	    if a_keyword(fz_undefine) then
	       if a_feature_name_list then
		  last_parent.set_undefine(last_feature_name_list)
	       end;
	    end;
	    if a_keyword(fz_redefine) then
	       if a_feature_name_list then
		  last_parent.set_redefine(last_feature_name_list)
	       end;
	    end;
	    if a_keyword(fz_select) then
	       if a_feature_name_list then
		  last_parent.set_select(last_feature_name_list);
	       end;
	    end;
	    if a_keyword(fz_rename) or else
	       a_keyword(fz_export) or else
	       a_keyword(fz_undefine) or else
	       a_keyword(fz_redefine) or else
	       a_keyword(fz_select) then
	       eh.add_position(pos(start_line,start_column));
	       fatal_error(
                  "Inheritance option not at a correct place. %
                  %The correct order is: %"rename... export... %
                  %undefine... redefine... select...%".");
	    end;
	    ok := a_keyword(fz_end);
	 end;
      end;

   a_prefix: BOOLEAN is
	 --++ prefix -> "prefix" "%"" unary "%""
	 --++           "prefix" "%"" free_operator "%""
	 --++
      do
	 if a_keyword(fz_prefix) then
	    Result := true;
	    if cc = '%"' then
	       next_char;
	    else
	       wcp("Character '%%%"' inserted after %"prefix%".");
	    end;
	    if a_unary then
	    elseif a_free_operator then
	       last_prefix := tmp_name.to_prefix_name;
	    else
	       fcp("Prefix operator name expected.");
	    end;
	    if not skip1('%"') then
	       wcp("Character '%%%"' inserted.");
	    end;
	 end;
      end;

   a_precursor(do_instruction: BOOLEAN): BOOLEAN is
	 --++ precursor -> ["{" class_name "}"] "Precursor" [actuals] |
	 --++              ^
	 --++
      local
	 l, c: INTEGER;
	 parent: CLASS_NAME;
	 args: EFFECTIVE_ARG_LIST;
	 p: POSITION;
      do
	 if skip1('{') then
	    Result := true;
	    l := start_line;
	    c := start_column;
	    if skip1('{') then
	       warning(pos(start_line,start_column),
	          "One single opening '{' is correct too here.");
	    end;
	    if a_base_class_name then
	       parent := last_class_name;
	    end;
	    if not skip1('}')  then
	       fcp("Closing '}' expected to end Precursor's parent %
                   %qualification.");
	    end;
	    if skip1('}') then
	       warning(pos(start_line,start_column),
		       "One single closing '}' is correct too here.");
	    end;
	 end;
	 if a_keyword(as_precursor) then
	    Result := true;
	    if l = 0 then
	       l := start_line;
	       c := start_column;
	    end;
	    args := a_actuals;
	 elseif l > 0 then
	    fcp("Precursor keyword expected here.");
	 end;
	 if Result then
	    p := pos(l,c);
	    if skip1('.') then
	       !PRECURSOR_EXPRESSION!last_expression.make(p,parent,args);
	       a_after_a_dot(do_instruction,last_expression);
	    elseif do_instruction then
	       !PRECURSOR_INSTRUCTION!last_instruction.make(p,parent,args);
	    else
	       !PRECURSOR_EXPRESSION!last_expression.make(p,parent,args);
	    end;
	 end;
      end;

   a_procedure_call is
	 --++ procedure_call -> [actuals] r10 |
	 --++                   ^
	 --++
      local
	 sfn: SIMPLE_FEATURE_NAME;
	 implicit_current: IMPLICIT_CURRENT;
      do
	 sfn := tmp_name.to_simple_feature_name;
	 !!implicit_current.make(sfn.start_position);
	 a_r10(true,implicit_current,sfn,a_actuals);
      end;

   a_real_constant: BOOLEAN is
	 --++ real_constant -> ["+" | "-"] real
	 --++
      local
	 l, c: INTEGER;
      do
	 l := line;
	 c := column;
	 if skip1('+') then
	    if a_real then
	       Result := true;
	    else
	       go_back_at(l,c);
	    end;
	 elseif skip1('-') then
	    if a_real then
	       last_real_constant.unary_minus;
	       Result := true;
	    else
	       go_back_at(l,c);
	    end;
	 elseif a_real then
	    Result := true;
	 end;
      end;

   a_rename_list is
	 --++ rename_list -> {rename_pair "," ...}
	 --++
      do
	 from
	 until
	    not a_rename_pair
	 loop
	    ok := skip1(',');
	 end;
      end;

   a_rename_pair: BOOLEAN is
	 --++ rename_pair -> identifier "as" identifier
	 --++
      local
	 name1: FEATURE_NAME;
	 rename_pair: RENAME_PAIR;
	 l, c: INTEGER;
      do
	 l := line;
	 c := column;
	 if a_feature_name then
	    name1 := last_feature_name;
	    if a_keyword(fz_as) then
	       if a_feature_name then
		  Result := true;
		  !!rename_pair.make(name1,last_feature_name);
		  last_parent.add_rename(rename_pair);
	       else
		  fcp("Second identifier of a %"rename%" pair expected.");
	       end;
	    else
	       go_back_at(l,c);
	    end;
	 end;
      end;

   a_routine: ROUTINE is
	 --++ routine -> ["obsolete" manifest_string]
	 --++            ["require" ["else"] assertion]
	 --++            ["local" entity_declaration_list]
	 --++            routine_body
	 --++            ["ensure" ["then"] assertion]
	 --++            ["rescue" compound]
	 --++            "end"
	 --++
      local
	 sp: POSITION;
	 hc: COMMENT;
	 al: ARRAY[ASSERTION];
	 ea: E_ENSURE;

      do
	 if a_keyword(fz_obsolete) then
	    if a_manifest_string then
	       tmp_feature.set_obsolete_mark(last_manifest_string);
	    else
	       fcp("Obsolete manifest string expected.");
	    end;
	 end;
	 tmp_feature.set_header_comment(get_comment);
	 if a_keyword(fz_require) then
	    sp := pos(start_line,start_column);
	    if a_keyword(fz_else) then
	       hc := get_comment;
	       tmp_feature.set_require_else(sp,hc,a_assertion);
	    else
	       hc := get_comment;
	       tmp_feature.set_require(sp,hc,a_assertion);
	    end;
	 end;
	 if a_keyword(fz_local) then
	    a_local_var_list;
	 end;
	 Result := a_routine_body;
	 if a_keyword(fz_ensure) then
	    sp := pos(start_line,start_column);
	    in_ensure := true;
	    if a_keyword(fz_then) then
	       hc := get_comment;
	       al := a_assertion;
	       if hc /= Void or else al /= Void then
		  !!ea.make(sp,hc,al);
		  ea.set_ensure_then;
	       end;
	       Result.set_ensure_assertion(ea);
	    else
	       hc := get_comment;
	       al := a_assertion;
	       if hc /= Void or else al /= Void then
		  !!ea.make(sp,hc,al);
	       end;
	       Result.set_ensure_assertion(ea);
	    end;
	    in_ensure := false;
	 end;
	 if a_keyword(fz_rescue) then
	    in_rescue := true;
	    Result.set_rescue_compound(a_compound2(fz_rescue,fz_end));
	    in_rescue := false;
	 elseif not a_keyword(fz_end) then
	    wcp("A routine must be ended with %"end%".");
	 end;
	 local_vars := Void;
      end;

   a_routine_body: ROUTINE is
	 --++ routine_body -> "deferred" |
	 --++                 "external" external |
	 --++                 "do" compound |
	 --++                 "once" compound
	 --++
      do
	 if a_keyword(fz_deferred) then
	    last_base_class.set_is_deferred;
	    Result := tmp_feature.to_deferred_routine;
	 elseif a_keyword(fz_external) then
	    Result := a_external;
	 elseif a_keyword(fz_do) then
	    tmp_feature.set_routine_body(a_compound1);
	    Result := tmp_feature.to_procedure_or_function;
	 elseif a_keyword(fz_once) then
	    inside_once_function := true;
	    tmp_feature.set_routine_body(a_compound1);
	    Result := tmp_feature.to_once_routine;
	 else
	    fcp("Routine body expected.");
	 end;
      end;

   a_r1(left_part: like last_expression) is
	 --++ r1 -> "implies" e1 r1 |
	 --++       ^
	 --++
      local
	 infix_implies: CALL_INFIX_IMPLIES;
	 sp: POSITION;
      do
	 if a_keyword(as_implies) then
	    sp := pos(start_line,start_column);
	    if a_e1 then
	       !!infix_implies.make(left_part,sp,last_expression);
	       a_r1(infix_implies);
	    else
	       error(sp,"Expression expected after 'implies'.");
	    end;
	 else
	    last_expression := left_part;
	 end;
      end;

   a_r2(left_part: like last_expression) is
	 --++ r2 -> "or else" e2 r2 |
	 --++       "or" e2 r2 |
	 --++       "xor" e2 r2 |
	 --++       ^
	 --++
      local
	 infix_or_else: CALL_INFIX_OR_ELSE;
	 infix_or: CALL_INFIX_OR;
	 infix_xor: CALL_INFIX_XOR;
	 sp: POSITION;
      do
	 if a_keyword(as_or) then
	    sp := pos(start_line,start_column);
	    if a_keyword(fz_else) then
	       if a_e2 then
		  !!infix_or_else.make(left_part,sp,last_expression);
		  a_r2(infix_or_else);
	       else
		  err_exp(sp,as_or_else);
	       end;
	    else
	       if a_e2 then
		  !!infix_or.make(left_part,sp,last_expression);
		  a_r2(infix_or);
	       else
		  err_exp(sp,as_or);
	       end;
	    end;
	 elseif a_keyword(as_xor) then
	    sp := pos(start_line,start_column);
	    if a_e2 then
	       !!infix_xor.make(left_part,sp,last_expression);
	       a_r2(infix_xor);
	    else
	       err_exp(sp,as_xor);
	    end;
	 else
	    last_expression := left_part;
	 end;
      end;

   a_r3(left_part: like last_expression) is
	 --++ r3 -> "and then" e3 r3 |
	 --++       "and" e3 r3 |
	 --++       ^
	 --++
      local
	 infix_and_then: CALL_INFIX_AND_THEN;
	 infix_and: CALL_INFIX_AND;
	 sp: POSITION;
      do
	 if a_keyword(as_and) then
	    sp := pos(start_line,start_column);
	    if a_keyword(fz_then) then
	       if a_e3 then
		  !!infix_and_then.make(left_part,sp,last_expression);
		  a_r3(infix_and_then);
	       else
		  err_exp(sp,as_and_then);
	       end;
	    else
	       if a_e3 then
		  !!infix_and.make(left_part,sp,last_expression);
		  a_r3(infix_and);
	       else
		  err_exp(sp,as_and);
	       end;
	    end;
	 else
	    last_expression := left_part;
	 end;
      end;

   a_r4(left_part: like last_expression) is
	 --++ r4 -> "=" e4 r4 |
	 --++       "/=" e4 r4 |
	 --++       "<=" e4 r4 |
	 --++       "<" e4 r4 |
	 --++       ">=" e4 r4 |
	 --++       ">" e4 r4 |
	 --++       ^
	 --++
      local
	 call_infix: CALL_INFIX;
	 sp: POSITION;
      do
	 if skip1('=') then
	    sp := pos(start_line,start_column);
	    if a_e4 then
	       !CALL_INFIX_EQ!call_infix.make(left_part,sp,last_expression);
	       a_r4(call_infix);
	    else
	       err_exp(sp,as_eq);
	    end;
	 elseif skip2('/','=') then
	    sp := pos(start_line,start_column);
	    if a_e4 then
	       !CALL_INFIX_NEQ!call_infix.make(left_part,sp,last_expression);
	       a_r4(call_infix);
	    else
	       err_exp(sp,as_neq);
	    end;
	 elseif skip2('<','=') then
	    sp := pos(start_line,start_column);
	    if a_e4 then
	       !CALL_INFIX_LE!call_infix.make(left_part,sp,last_expression);
	       a_r4(call_infix);
	    else
	       err_exp(sp,as_le);
	    end;
	 elseif skip2('>','=') then
	    sp := pos(start_line,start_column);
	    if a_e4 then
	       !CALL_INFIX_GE!call_infix.make(left_part,sp,last_expression);
	       a_r4(call_infix);
	    else
	       err_exp(sp,as_ge);
	    end;
	 elseif skip1('<') then
	    sp := pos(start_line,start_column);
	    if a_e4 then
	       !CALL_INFIX_LT!call_infix.make(left_part,sp,last_expression);
	       a_r4(call_infix);
	    else
	       err_exp(sp,as_lt);
	    end;
	 elseif skip1unless2('>','>') then
	    sp := pos(start_line,start_column);
	    if a_e4 then
	       !CALL_INFIX_GT!call_infix.make(left_part,sp,last_expression);
	       a_r4(call_infix);
	    else
	       err_exp(sp,as_gt);
	    end;
	 else
	    last_expression := left_part;
	 end;
      end;

   a_r5(left_part: like last_expression) is
	 --++ r5 -> "+" e5 r5 |
	 --++       "-" e5 r5 |
	 --++       ^
	 --++
      local
	 infix_plus: CALL_INFIX_PLUS;
	 infix_minus: CALL_INFIX_MINUS;
	 sp: POSITION;
      do
	 if skip1('+') then
	    sp := pos(start_line,start_column);
	    if a_e5 then
	       !!infix_plus.make(left_part,sp,last_expression);
	       a_r5(infix_plus);
	    else
	       err_exp(sp,as_plus);
	    end;
	 elseif skip1('-') then
	    sp := pos(start_line,start_column);
	    if a_e5 then
	       !!infix_minus.make(left_part,sp,last_expression);
	       a_r5(infix_minus);
	    else
	       err_exp(sp,as_minus);
	    end;
	 else
	    last_expression := left_part;
	 end;
      end;

   a_r6(left_part: like last_expression) is
	 --++ r6 -> "*" e6 r6 |
	 --++       "//" e6 r6 |
	 --++       "\\" e6 r6 |
	 --++       "/" e6 r6 |
	 --++       ^
	 --++
      local
	 infix_times: CALL_INFIX_TIMES;
	 infix_int_div: CALL_INFIX_INT_DIV;
	 infix_int_rem: CALL_INFIX_INT_REM;
	 infix_div: CALL_INFIX_DIV;
	 sp: POSITION;
      do
	 if skip1('*') then
	    sp := pos(start_line,start_column);
	    if a_e6 then
	       !!infix_times.make(left_part,sp,last_expression);
	       a_r6(infix_times);
	    else
	       err_exp(sp,as_muls);
	    end;
	 elseif skip2('/','/') then
	    sp := pos(start_line,start_column);
	    if a_e6 then
	       !!infix_int_div.make(left_part,sp,last_expression);
	       a_r6(infix_int_div);
	    else
	       err_exp(sp,as_slash_slash);
	    end;
	 elseif skip2('\','\') then
	    sp := pos(start_line,start_column);
	    if a_e6 then
	       !!infix_int_rem.make(left_part,sp,last_expression);
	       a_r6(infix_int_rem);
	    else
	       err_exp(sp,as_backslash_backslash);
	    end;
	 elseif skip1unless2('/','=') then
	    sp := pos(start_line,start_column);
	    if a_e6 then
	       !!infix_div.make(left_part,sp,last_expression);
	       a_r6(infix_div);
	    else
	       err_exp(sp,as_slash);
	    end;
	 else
	    last_expression := left_part;
	 end;
      end;

   a_r7(left_part: like last_expression) is
	 --++ r7 -> "^" e7 r7 |
	 --++       ^
	 --++
      local
         sp: POSITION;
      do
         if skip1('^') then
            sp := pos(start_line,start_column);
            if a_e7 then
               a_r7(last_expression);
               !CALL_INFIX_POWER!last_expression.make(left_part,sp,
						      last_expression);
            else
               err_exp(sp,as_pow);
            end;
         else
            last_expression := left_part;
         end;
      end;

   a_r8(left_part: like last_expression) is
	 --++ r8 -> free_operator e8 r8 |
	 --++       ^
	 --++
      local
	 infix_name: INFIX_NAME;
	 infix_freeop: CALL_INFIX_FREEOP;
      do
	 if a_free_operator then
	    infix_name := tmp_name.to_infix_name_use;
	    if a_e8 then
	       !!infix_freeop.make(left_part,infix_name,last_expression);
	       a_r8(infix_freeop);
	    else
	       err_exp(infix_name.start_position,infix_name.to_string);
	    end;
	 else
	    last_expression := left_part;
	 end;
      end;

   a_r10(do_instruction: BOOLEAN; t: EXPRESSION; fn: FEATURE_NAME;
	 eal: EFFECTIVE_ARG_LIST) is
	 --++ r10 -> "." after_a_dot |
	 --++        ^
	 --++
      do
	 if skip1('.') then
	    if t /= Void and then t.is_void then
	       eh.add_position(t.start_position);
	       fatal_error("Void is not a valid target.");
	    end;
	    a_after_a_dot(do_instruction,to_call(t,fn,eal));
	 else
	    if do_instruction then
	       last_instruction := to_proc_call(t,fn,eal);
	       last_expression := Void;
	    else
	       last_expression := to_call(t,fn,eal);
	       last_instruction := Void;
	    end;
	 end;
      end;

   a_strip: BOOLEAN is
	 --++ a_strip -> "strip" "(" {identifier "," ...} ")"
      local
	 sp: POSITION;
      do
	 if a_keyword(fz_strip) then
	    sp := pos(start_line,start_column);
	    if skip1('(') then
	       ok := a_feature_name_list;
	       !E_STRIP!last_expression.make(sp,last_feature_name_list);
	       if not skip1(')') then
		  fcp("')' expected to end a strip expression.");
	       end;
	       Result := true;
	    else
	       fcp("'(' expected to begin a strip list.");
	    end;
	 end;
      end;

   a_tag_mark: BOOLEAN is
	 --++ tag_mark -> identifier ":"
	 --++
      local
	 l, c: INTEGER;
      do
	 l := line;
	 c := column;
	 if a_identifier then
	    if skip1(':') then
	       Result := true;
	       last_tag_mark := tmp_name.to_tag_name;
	    else
	       go_back_at(l,c);
	    end;
	 end;
      end;

   a_then_part_list(ifthenelse: IFTHENELSE) is
	 --++ then_part_list -> {then_part "elseif"}+
	 --++
      do
	 from
	    if not a_then_part(ifthenelse) then
	       fcp("In %"if ... then ...%".");
	    end;
	 until
	    not a_keyword(fz_elseif)
	 loop
	    if not a_then_part(ifthenelse) then
	       fcp("In %"elseif ... then ...%".");
	    end;
	 end;
      end;

   a_then_part(ifthenelse: IFTHENELSE): BOOLEAN is
	 --++ then_part -> expression "then"
	 --++
      local
	 expression: EXPRESSION;
      do
	 if a_expression then
	    Result := true;
	    expression := last_expression.add_comment(get_comment);
	    if not a_keyword(fz_then) then
	       wcp("Added %"then%".");
	    end;
	    ifthenelse.add_if_then(expression,a_compound1);
	 end;
      end;

   a_type: BOOLEAN is
	 --++ type -> "like" <anchor> | "expanded" class_type | BIT <constant>
	 --++         type_formal_generic | class_type
	 --++
      local
	 sp: POSITION;
	 argument_name2: ARGUMENT_NAME2;
      do
	 Result := true;
	 if a_keyword(fz_like) then
	    sp := pos(start_line,start_column);
	    if a_infix then
	       !TYPE_LIKE_FEATURE!last_type.make(sp,last_infix);
	    elseif a_prefix then
	       !TYPE_LIKE_FEATURE!last_type.make(sp,last_prefix);
	    elseif a_identifier then
	       if a_current then
		  !TYPE_LIKE_CURRENT!last_type.make(sp);
	       elseif a_argument then
		  argument_name2 ?= last_expression;
		  !TYPE_LIKE_ARGUMENT!last_type.make(sp,argument_name2);
	       else
		  !TYPE_LIKE_FEATURE!last_type.make(sp,
				           tmp_name.to_simple_feature_name);
	       end;
	    else
	       fcp("Anchor expected. An anchor could be `Current', %
		   %a feature name or an argument name.");
	    end;
	 elseif a_keyword(fz_expanded) then
	    sp := pos(start_line,start_column);
	    if a_class_type then
	       !TYPE_EXPANDED!last_type.make(sp,last_class_type);
	    else
	       fcp("Must find a class type after %"expanded%".");
	    end;
	 elseif a_keyword(as_bit) then
	    sp := pos(start_line,start_column);
	    if a_integer then
	       !TYPE_BIT_1!last_type.make(sp,last_integer_constant);
	    elseif a_identifier then
	       !TYPE_BIT_2!last_type.make(sp,tmp_name.to_simple_feature_name);
	    else
	       fcp("Expected constant for BIT_N type declaration.");
	    end;
	 elseif a_type_formal_generic then
	    last_type := last_type_formal_generic;
	 elseif a_class_type then
	    last_type := last_class_type;
	 else
	    Result := false;
	 end;
      end;

   a_unary: BOOLEAN is
	 --++ unary -> "not" | "+" | "-"
	 --++
      do
	 if a_keyword(as_not) then
	    !!last_prefix.make(as_not,pos(start_line,start_column));
	    Result := true;
	 elseif skip1('+') then
	    !!last_prefix.make(as_plus,pos(start_line,start_column));
	    Result := true;
	 elseif skip1('-') then
	    !!last_prefix.make(as_minus,pos(start_line,start_column));
	    Result := true;
	 end;
      end;

   a_when_part(i: E_INSPECT): BOOLEAN is
	 --++ when_part -> "when" {when_part_item "," ...} then compound
	 --++
	 --++ when_part_item -> constant ".." constant |
	 --++                   constant
	 --++
	 --++ constant -> character_constant | integer_constant | identifier
	 --++
      local
	 state: INTEGER;
	 -- state 0 : sepator read, waiting a constant or "then".
	 -- state 1 : first constant read.
	 -- state 2 : ".." read.
	 -- state 3 : slice read.
	 -- state 4 : end.
	 e_when: E_WHEN;
	 constant: EXPRESSION;
      do
	 if a_keyword(fz_when) then
	    from
	       Result := true;
	       !!e_when.make(pos(start_line,start_column),get_comment);
	    until
	       state > 3
	    loop
	       inspect
		  state
	       when 0 then
		  if a_constant then
		     constant := last_expression;
		     state := 1;
		  elseif a_keyword(fz_then) then
		     if constant /= Void then
			e_when.add_value(constant);
		     end;
		     e_when.set_compound(a_compound1);
		     i.add_when(e_when);
		     state := 4;
		  elseif cc = ',' then
		     wcp(em7);
		     ok := skip1(',');
		  else
		     fcp(em4);
		     state := 4;
		  end;
	       when 1 then
		  if a_keyword(fz_then) then
		     if constant /= Void then
			e_when.add_value(constant);
		     end;
		     e_when.set_compound(a_compound1);
		     i.add_when(e_when);
		     state := 4;
		  elseif skip2('.','.') then
		     state := 2;
		  elseif skip1(',') then
		     e_when.add_value(constant);
		     constant := Void;
		     state := 0;
		  else
		     fcp(em4);
		     state := 4;
		  end;
	       when 2 then
		  if a_constant then
		     e_when.add_slice(constant,last_expression);
		     constant := Void;
		     state := 3;
		  else
		     fcp(em4);
		     state := 4;
		  end;
	       else -- state = 3
		  if skip1(',') then
		     state := 0;
		  elseif a_keyword(fz_then) then
		     e_when.set_compound(a_compound1);
		     i.add_when(e_when);
		     state := 4;
		  elseif a_constant then
		     constant := last_expression;
		     warning(tmp_name.start_position,em5);
		     state := 1;
		  else
		     fcp(em4);
		     state := 4;
		  end;
	       end;
	    end;
	 end;
      end;

   mandatory_writable: EXPRESSION is
	 -- Skip and return the writable which is mandatory here.
      do
	 if a_identifier then
	    if a_current then
	       eh.add_position(last_expression.start_position);
	       eh.append("Current is not a writable variable.");
	       eh.print_as_fatal_error;
	    elseif a_argument then
	       eh.add_position(last_expression.start_position);
	       eh.append(em21);
	       eh.print_as_fatal_error;
	    elseif a_result or else a_local_variable then
	       Result := last_expression;
	    else
	       Result := tmp_name.to_simple_feature_name;
	    end;
	 else
	    fcp(em22);
	 end;
      ensure
	 Result /= Void
      end;
   
   to_call(t: EXPRESSION; fn: FEATURE_NAME;
	   eal: EFFECTIVE_ARG_LIST): EXPRESSION is
      require
	 t /= Void;
      do
	 if fn = Void then
	    check
	       eal = Void;
	    end;
	    Result := t;
	 elseif eal = Void then
	    !CALL_0_C!Result.make(t,fn);
	 elseif eal.count = 1 then
	    !CALL_1_C!Result.make(t,fn,eal);
	 else
	    !CALL_N!Result.make(t,fn,eal);
	 end;
      end;

   to_proc_call(t: EXPRESSION; fn: FEATURE_NAME;
		eal: EFFECTIVE_ARG_LIST): PROC_CALL is
      do
	 if fn = Void then
	    fcp("An expression has a result value. %
		%This is not an instruction.");
	 elseif eal = Void then
	    !PROC_CALL_0!Result.make(t,fn);
	 elseif eal.count = 1 then
	    !PROC_CALL_1!Result.make(t,fn,eal);
	 else
	    !PROC_CALL_N!Result.make(t,fn,eal);
	 end;
      end;

   wcpefnc(old_name, new_name: STRING) is
      do
	 eh.append("For readability, the keyword %"");
	 eh.append(old_name);
	 eh.append("%" is now %"");
	 eh.append(new_name);
	 wcp("%". You should update your Eiffel code now.");
      end;

   lcs: STRING is
	 -- Last Comment String.
      once
	 !!Result.make(80);
      end;

   buffer: STRING is
      once
	 !!Result.make(80);
      end;

   a_identifier1: BOOLEAN is
	 -- Case Insensitive (option -case_insensitive).
      require
	 case_insensitive
      local
	 backward_column: INTEGER;
	 stop: BOOLEAN;
      do
	 if cc.is_letter then
	    from
	       backward_column := column;
	       tmp_name.reset(pos(line,backward_column));
	       tmp_name.extend(cc.to_lower);
	    until
	       stop
	    loop
	       next_char;
	       inspect
		  cc
	       when 'a'..'z' then
		  tmp_name.extend(cc);
	       when '0'..'9','_' then
		  tmp_name.extend(cc);
	       when 'A'..'Z' then
		  tmp_name.extend(cc.to_lower);
	       else
		  stop := true;
	       end;
	    end;
	    if tmp_name.isa_keyword then
	       cc := tmp_name.buffer.first;
	       column := backward_column;
	    else
	       Result := true;
	       skip_comments;
	    end;
	 end;
      end;

   a_identifier2: BOOLEAN is
	 -- Case Sensitivity for identifiers (default).
      require
	 not case_insensitive
      local
	 backward_column: INTEGER;
	 stop, may_be_a_keyword, style_warning: BOOLEAN;
      do
	 if cc.is_letter then
	    from
	       backward_column := column;
	       may_be_a_keyword := true;
	       tmp_name.reset(pos(line,backward_column));
	       tmp_name.extend(cc);
	    until
	       stop
	    loop
	       next_char;
	       inspect
		  cc
	       when 'a'..'z' then
		  tmp_name.extend(cc);
	       when 'A'..'Z' then
		  style_warning := true;
		  tmp_name.extend(cc);
	       when '0'..'9','_' then
		  may_be_a_keyword := false;
		  tmp_name.extend(cc);
	       else
		  stop := true;
	       end;
	    end;
	    if may_be_a_keyword and then tmp_name.isa_keyword then
	       cc := tmp_name.buffer.first;
	       column := backward_column;
	    else
	       Result := true;
	       skip_comments;
	       if style_warning then
		  if not no_style_warning then
		     warning(tmp_name.start_position,em25);
		  end;
	       end;
	    end;
	 end;
      end;

   line, column: INTEGER;
	 -- Current `line' number and current `column' number.

   current_line: STRING;
	 -- Current line string of `text'.

   cc: CHARACTER;
	 -- Current character in the `current_line'.

   show_nb(nb: INTEGER; tail: STRING) is
      do
	 if nb > 0 then
	    echo.w_put_string(fz_error_stars);
	    echo.w_put_integer(nb);
	    echo.w_put_string(tail);
	 end;
      end;

   tmp_feature: TMP_FEATURE;

   drop_comments: BOOLEAN;
	 -- When objects COMMENT are not necessary.

   current_id: INTEGER;
	 -- This is the `id' of the `last_base_class' or the `id' of 
	 -- the cecil file path.

   pos(l, c: INTEGER): POSITION is
      require
	 l >= 1;
	 c >= 1
      do
	 Result.set(l,c,current_id,last_base_class);
      end;

   to_frozen_feature_name is
      do
	 !FROZEN_FEATURE_NAME!last_feature_name.make(last_feature_name);
      end;

   last_result: ABSTRACT_RESULT is
      local
	 sp: POSITION;
      do
	 sp := tmp_name.start_position;
	 if inside_function then
	    if inside_once_function then
	       !ONCE_RESULT!Result.make(sp);
	    else
	       !ORDINARY_RESULT!Result.make(sp);
	    end;
	 else
	    eh.add_position(sp);
	    fatal_error("`Result' must only be used inside a function.");
	 end;
      ensure
	 Result /= Void
      end;

   faof: FIXED_ARRAY[E_FEATURE] is
      once
	 !!Result.with_capacity(256);
      end;

   err_exp(sp: POSITION; operator: STRING) is
	 -- When an error occurs in the right hand side of `operator'.
      local
	 msg: STRING;
      do
	 !!msg.make(0);
	 msg.append("Right hand side expression of %"");
	 msg.append(operator);
	 msg.append("%" expected.");
	 eh.add_position(sp);
	 fatal_error(msg);
      end;

   fcp(msg: STRING) is
	 -- Fatal error at current position.
      do
	 eh.add_position(current_position);
	 fatal_error(msg);
      end;

   wcp(msg: STRING) is
	 -- Warning at current position.
      do
	 warning(current_position,msg);
      end;

   current_position: POSITION is
      do
	 Result := pos(line,column);
      end;

   em1 : STRING is "Underscore in fractionnal part must group 3 digits.";
   em2 : STRING is "Feature name expected.";
   em3 : STRING is "Index value expected (%"indexing ...%").";
   em4 : STRING is "Error in inspect.";
   em5 : STRING is "Added %",%".";
   em6 : STRING is "Added %";%".";
   em7 : STRING is "Unexpected comma (deleted)."
   em8 : STRING is "Unexpected new line in manifest string.";
   em9 : STRING is "Underscore in number must group 3 digits.";
   em10: STRING is "Bad character constant.";
   em11: STRING is "Bad clients list.";
   em12: STRING is "Deleted extra coma.";
   em13: STRING is "Deleted extra separator.";
   em14: STRING is "Class name should use only uppercase letters.";
   em15: STRING is "Name of the current class expected.";
   em16: STRING is "Type mark expected.";
   em17: STRING is "Unexpected character.";
   em18: STRING is "Bad external clause ('%"' expected).";
   em19: STRING is "Bad alias clause ('%"' expected).";
   em20: STRING is "Explicit creation/create type mark must not be anchored.";
   em21: STRING is "A formal argument is not a writable variable.";
   em22: STRING is "Bad creation/create (writable expected).";
   em23: STRING is "Bad creation/create (procedure name expected).";
   em24: STRING is "Deleted extra semi-colon.";
   em25: STRING is "Identifier should use only lowercase letters.";
   em26: STRING is "Same identifier appears twice (local/formal).";

   singleton_memory: EIFFEL_PARSER is
      once
	 Result := Current;
      end;

invariant

   is_real_singleton: Current = singleton_memory

end -- EIFFEL_PARSER

