--          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 BASE_CLASS
   --
   -- Internal representation of an Eiffel source base class.
   --

inherit GLOBALS;

creation {EIFFEL_PARSER, TYPE_NONE, TYPE_TUPLE} make

feature

   id: INTEGER;
	 -- To produce compact C code.

   path: STRING;
	 -- Access to the corresponding file.

   index_list: INDEX_LIST;
	 -- For the indexing of the class.

   heading_comment1: COMMENT;
	 -- Comment before keyword `class'.

   is_deferred: BOOLEAN;
	 -- True if class itself is deferred or if at least one
	 -- feature is deferred;

   is_expanded: BOOLEAN;
	 -- True if class itself is expanded.

   name: CLASS_NAME;
	 -- The name of the class.

   formal_generic_list: FORMAL_GENERIC_LIST;
	 -- Formal generic args if any.

   heading_comment2: COMMENT;
	 -- Comment after class name.

   obsolete_type_string: MANIFEST_STRING;
	 -- To warn user if any.

      parent_list: PARENT_LIST;
      -- The contents of the inherit clause if any.

      creation_clause_list: CREATION_CLAUSE_LIST;
      -- Constructor list.

      feature_clause_list: FEATURE_CLAUSE_LIST;
      -- Features.

      class_invariant: CLASS_INVARIANT;
      -- If any, the class invariant.

      end_comment: COMMENT;
      -- Comment after end of class.

feature {NONE}

   feature_dictionary: DICTIONARY[E_FEATURE,STRING];
	 -- All features really defined in the current class. Thus, it is 
	 -- the same features contained in `feature_clause_list' (this dictionary 
	 -- speed up feature look up). To avoid clash between infix and 
	 -- prefix names, access key is not `to_string' but `to_key'.

   make(my_path, my_name: STRING; my_id: INTEGER) is
      require
	 my_path = string_aliaser.item(my_path);
	 my_name = string_aliaser.item(my_name);
	 my_id >= 0
      do
	 path := my_path;
	 !!name.unknown_position(my_name);
	 id := my_id;
	 small_eiffel.add_base_class(Current);
	 !!feature_dictionary.make;
      end;

feature {TYPE_CLASS}

   smallest_ancestor(type, other: TYPE): TYPE is
	 -- To help implementation of TYPE.smallest_ancestor while one
	 -- have to consider parents. Note that `type' is directly related 
	 -- to `Current'.
      require
	 type.is_run_type;
	 other.is_run_type;
	 type.base_class = Current;
	 not other.is_any;
	 not other.is_none;
	 other.base_class /= Void
      do
	 if is_any then
	    Result := type;
	 elseif type.run_time_mark = other.run_time_mark then
	    Result := type;
	 elseif parent_list = Void then
	    Result := type_any;
	 elseif other.base_class.parent_list = Void then
	    Result := type_any;
	 else
	    Result := parent_list.smallest_ancestor(type,other);
	 end;
      ensure
	 Result /= Void
      end;

feature {SHORT,PARENT_LIST}

   up_to_any_in(pl: FIXED_ARRAY[BASE_CLASS]) is
      do
	 if not is_general then
	    if not pl.fast_has(Current) then
	       pl.add_last(Current);
	    end;
	    if parent_list = Void then
	       if not pl.fast_has(class_any) then
		  pl.add_last(class_any);
	       end;
	    else
	       parent_list.up_to_any_in(pl);
	    end;
	 end;
      end;

feature

   expanded_initializer(t: TYPE): RUN_FEATURE_3 is
      require
	 t.is_expanded
      do
	 if creation_clause_list /= Void then
	    Result := creation_clause_list.expanded_initializer(t);
	 end;
      end;

feature {RUN_CLASS}

   get_default_rescue(rc: RUN_CLASS; n: FEATURE_NAME): RUN_FEATURE_3 is
      local
	 general: BASE_CLASS;
	 p: PROCEDURE;
	 fn1, fn2: FEATURE_NAME;
      do
	 general := class_general;
	 if Current /= general then
	    p := general.general_default_rescue;
	    if p /= Void then
	       fn1 := p.first_name;
	       fn2 := new_name_of(general,fn1);
	       if fn2.to_string /= n.to_string then
		  p ?= look_up_for(rc,fn2);
		  if p /= Void then
		     Result := p.a_default_rescue(rc,fn2);
		  end;
	       end;
	    end;
	 end;
      end;

   check_expanded_with(t: TYPE) is
      require
	 t.is_expanded;
	 t.base_class = Current
      local
	 rf: RUN_FEATURE;
      do
	 if is_deferred then
	    eh.add_type(t,fz_is_invalid);
	    fatal_error(" A deferred class must not be expanded (VTEC.1).");
	 end;
	 if creation_clause_list /= Void then
	    creation_clause_list.check_expanded_with(t);
	 end;
	 rf := expanded_initializer(t);
      end;

feature {RUN_FEATURE,ONCE_ROUTINE_POOL}

   once_flag(mark: STRING): BOOLEAN is
	 -- Flag used to avoid double C definition of globals
	 -- C variables for once routines.
      require
	 mark = string_aliaser.item(mark);
	 small_eiffel.is_ready
      do
	 if once_mark_list = Void then
	    !!once_mark_list.with_capacity(4);
	    once_mark_list.add_last(mark);
	 elseif once_mark_list.fast_has(mark) then
	    Result := true;
	 else
	    once_mark_list.add_last(mark);
	 end;
      ensure
	 once_flag(mark)
      end;

feature {NONE}

   once_mark_list: FIXED_ARRAY[STRING];
	 -- When the tag is in the list, the corresponding routine
	 -- does not use Current and C code is already written.

feature {TYPE_FORMAL_GENERIC}

   first_parent_for(other: like Current): PARENT is
	 -- Assume `other' is a parent of Current, gives
	 -- the closest PARENT of Current going to `other'.
      require
	 is_subclass_of(other);
	 parent_list /= Void
      do
	 Result := parent_list.first_parent_for(other);
      ensure
	 Result /= Void
      end;

   next_parent_for(other: like Current; previous: PARENT): like previous is
	 -- Gives the next one or Void.
      require
	 is_subclass_of(other);
	 parent_list /= Void
      do
	 Result := parent_list.next_parent_for(other,previous);
      end;

feature

   new_name_of(top: BASE_CLASS; top_fn: FEATURE_NAME): FEATURE_NAME is
	 -- Assume, `top_fn' is a valid notation to denote a feature of `top'.
	 -- It computes the corresponding name (taking in account possible 
	 -- rename/select) to use this feature down in class hierarchy (in 
	 -- the Current base_class).
      require
	 Current = top or else Current.is_subclass_of(top);
	 top_fn /= Void
      do
	 if Current = top then
	    Result := top_fn;
	 else
	    Result := top.up_to_original(Current,top_fn);
	    if Result = Void then
	       eh.add_position(top_fn.start_position);
	       eh.append(fz_09);
	       eh.append(top_fn.to_string);
	       eh.append("%" from %"");
	       eh.append(top.name.to_string);
	       eh.append("%" not found in %"");
	       eh.append(name.to_string);
	       fatal_error("%".");
	    end;
	 end;
      ensure
	 Result /= Void
      end;

feature {BASE_CLASS,PARENT}

   up_to_original(bottom: BASE_CLASS; top_fn: FEATURE_NAME): FEATURE_NAME is
	 -- Assume `top_fn' is a valid name in `bottom'. Try to go up in the 
	 -- hierarchy to retrieve the original name of the feature.
      require
	 top_fn /= Void;
	 Current = bottom or else bottom.is_subclass_of(Current)
      do
	 if proper_has(top_fn) then
	    if parent_list = Void then
	       Result := bottom.new_name_of_original(Current,top_fn);
	    else
	       Result := parent_list.up_to_original(bottom,top_fn);
	       if Result = Void then
		  Result := bottom.new_name_of_original(Current,top_fn);
	       end;
	    end;
	 elseif parent_list /= Void then
	    Result := parent_list.up_to_original(bottom,top_fn);
	 elseif is_general then
	 else
	    Result := class_any.up_to_original(bottom,top_fn);
	 end;
      end;

feature {RUN_FEATURE_1,PARENT,BASE_CLASS}

   original_name(top: BASE_CLASS; bottom_fn: FEATURE_NAME): FEATURE_NAME is
	 -- Assume that `bottom_fn' is a valid name in `Current'. Compute the 
	 -- original definition name going up in the hierarchy to `top'.
      require
	 bottom_fn /= Void;
	 Current = top or else Current.is_subclass_of(top)
      do
	 if Current = top then
	    check 
	       name.to_string /= as_tuple implies proper_has(bottom_fn)
	    end;
	    Result := bottom_fn;
	 elseif parent_list /= Void then
	    Result := parent_list.original_name(top,bottom_fn);
	 else
	    Result := top.original_name(top,bottom_fn);
	    if Result = Void then
	       Result := bottom_fn;
	       eh.add_position(bottom_fn.start_position);
	       eh.append(top.name.to_string);
	       eh.append("<---");
	       eh.append(name.to_string);
	       eh.append(". BASE_CLASS.original_name, Not Yet Implemented.");
	       eh.print_as_warning;
	    end;
	 end;
      ensure
	 Result /= Void
      end;

feature {BASE_CLASS}

   new_name_of_original(top: BASE_CLASS; top_fn: FEATURE_NAME): FEATURE_NAME is
	 -- Compute rename/select to go down in class hierarchy. In the very 
	 -- first call, `top_fn' is the name used in `top'.
      require
	 top_fn /= Void;
	 top.proper_has(top_fn);
	 Current = top or else Current.is_subclass_of(top)
      do
	 if Current = top then
	    Result := top_fn;
	 elseif is_general then
	    Result := top_fn;
	 else
	    if parent_list = Void then
	       Result := class_any.new_name_of(top,top_fn);
	    else
	       going_up_trace.clear;
	       Result := parent_list.going_up(going_up_trace,top,top_fn);
	    end;
	 end;
      ensure
	 Result /= Void
      end;

   general_default_rescue: PROCEDURE is
      do
	 if feature_dictionary.has(as_default_rescue) then
	    Result ?= feature_dictionary.at(as_default_rescue);
	 end;
      end;

feature {BASE_CLASS,PARENT_LIST,PARENT}

   going_up(trace: FIXED_ARRAY[PARENT]; top: BASE_CLASS;
	    top_fn: FEATURE_NAME;): FEATURE_NAME is
      require
	 Current /= top
      do
	 if parent_list = Void then
	    Result := class_any.going_up(trace,top,top_fn);
	 else
	    Result := parent_list.going_up(trace,top,top_fn);
	 end;
      end;

feature {NONE}

   going_up_trace: FIXED_ARRAY[PARENT] is
      once
	 !!Result.with_capacity(8);
      end;

feature

   mapping_c_in(str: STRING) is
      do
	 str.extend('B');
	 str.extend('C');
	 id.append_in(str);
      end;

   mapping_c is
      local
	 s: STRING;
      do
	 s := "        ";
	 s.clear;
	 mapping_c_in(s);
	 cpp.put_string(s);
      end;

feature {EIFFEL_PARSER}

   add_index_clause(index_clause: INDEX_CLAUSE) is
      require
	 index_clause /= Void
      do
	 if index_list = Void then
	    !!index_list.make(index_clause);
	 else
	    index_list.add_last(index_clause);
	 end;
      end;

   add_creation_clause(cc: CREATION_CLAUSE) is
      require
	 cc /= Void
      do
	 if creation_clause_list = Void then
	    !!creation_clause_list.make(cc);
	 else
	    creation_clause_list.add_last(cc);
	 end;
      end;

   add_feature_clause(fc: FEATURE_CLAUSE) is
      require
	 fc /= Void
      do
	 if feature_clause_list = Void then
	    !!feature_clause_list.make(fc);
	 else
	    feature_clause_list.add_last(fc);
	 end;
      end;

   set_is_deferred is
      do
	 if is_expanded then
	    error_vtec1;
	 end;
	 is_deferred := true;
      end;

   set_is_expanded is
      do
	 if is_deferred then
	    error_vtec1;
	 end;
	 is_expanded := true;
      end;

   set_formal_generic_list(fgl: like formal_generic_list) is
      do
	 formal_generic_list := fgl;
      end;

   set_heading_comment1(hc: like heading_comment1) is
      do
	 heading_comment1 := hc;
      end;

   set_heading_comment2(hc: like heading_comment2) is
      do
	 heading_comment2 := hc;
      end;

   set_parent_list(sp: POSITION; c: COMMENT; l: FIXED_ARRAY[PARENT]) is
      require
	 not sp.is_unknown;
	 c /= Void or else l /= Void;
	 l /= Void implies not l.is_empty;
      do
	 !!parent_list.make(Current,sp,c,l);
      end;

   set_end_comment(ec: like end_comment) is
      do
	 end_comment := ec;
      end;

   set_obsolete_type_string(ots: like obsolete_type_string) is
      do
	 obsolete_type_string := ots;
	 if obsolete_type_string /= Void then
	    if small_eiffel.short_flag then
	    elseif small_eiffel.pretty_flag then
	    else
	       eh.append("Class ");
	       eh.append(name.to_string);
	       eh.append(" is obsolete :%N");
	       eh.append(obsolete_type_string.to_string);
	       eh.add_position(name.start_position);
	       eh.print_as_warning;
	       end
	    end;
	 end;

	 set_invariant(sp: POSITION; hc: COMMENT; al: ARRAY[ASSERTION]) is
      do
	 if hc /= Void or else al /= Void then
	    !!class_invariant.make(sp,hc,al);
	 end;
      end;

   get_started is
      do
	 if feature_clause_list /= Void then
	    feature_clause_list.get_started(feature_dictionary);
	 end;
	 if parent_list /= Void then
	    parent_list.get_started;
	 end;
	 if end_comment /= Void then
	    end_comment.good_end(name);
	 end;
	 if parent_list /= Void then
	    visited.clear;
	    visited.add_last(Current);
	    parent_list.inherit_cycle_check;
	 end;
	 if run_control.all_check and then
	    is_deferred and then
	    creation_clause_list /= Void
	  then
	    eh.add_position(name.start_position);
	    warning(creation_clause_list.start_position,
		    "Deferred class should not have %
		    %creation clause (VGCP.1).");
	 end;
      end;

feature

   get_copy: E_FEATURE is
      do
	 Result := feature_dictionary.at(as_copy);
      ensure
	 Result /= Void
      end;

   clients_for(fn: FEATURE_NAME): CLIENT_LIST is
	 -- Looking up for the clients list when calling feature `fn' with 
	 -- some object from current class. Assume `fn' exists.
      do
	 if proper_has(fn) then
	    Result := feature_dictionary.at(fn.to_key).clients;
	 elseif is_general then
	 elseif parent_list = Void then
	    Result := class_any.clients_for(fn);
	 else
	    check
	       parent_list.count >= 1
	    end;
	    Result := parent_list.clients_for(fn);
	 end;
      ensure
	 -- *** ??? Result /= Void
      end;

   has_creation_clause: BOOLEAN is
      do
	 Result := creation_clause_list /= Void;
      end;

   has_creation(proc_name: FEATURE_NAME): BOOLEAN is
	 -- Is `proc_name' the name of a creation procedure ?
	 -- Also check that `proc_name' is written in an allowed
	 -- base class for creation.
      require
	 proc_name.origin_base_class /= Void
      local
	 cc: CREATION_CLAUSE;
	 bc: BASE_CLASS;
	 cn: CLASS_NAME;
      do
	 if creation_clause_list = Void then
	    eh.append(name.to_string);
	    eh.append(" has no creation clause.");
	    eh.add_position(proc_name.start_position);
	    eh.print_as_error;
	 else
	    cc := creation_clause_list.get_clause(proc_name);
	    if cc = Void then
	       eh.append(fz_09);
	       eh.append(proc_name.to_string);
	       eh.append("%" does not belong to a creation clause of ");
	       eh.append(name.to_string);
	       error(proc_name.start_position,fz_dot);
	    else
	       Result := true;
	       bc := proc_name.origin_base_class;
	       if bc /= Void then
		  cn := bc.name;
		  Result := cc.clients.gives_permission_to(cn);
	       end;
	    end;
	 end;
	 if not Result then
	    error(proc_name.start_position,"Creation Call not allowed.");
	 end;
      end;

feature {SMALL_EIFFEL,BASE_CLASS}

   root_procedure_name(procedure_name: STRING): SIMPLE_FEATURE_NAME is
	 -- Look for the root procedure to start execution here.
	 -- Check that `procedure_name' is really a creation procedure.
      require
	 not procedure_name.is_empty
      do
	 if creation_clause_list = Void then
	    eh.add_position(name.start_position);
	    fatal_error("Bad root class (this class has no creation clause).");
	 else
	    Result := creation_clause_list.root_procedure_name(procedure_name);
	    if Result = Void then
	       eh.add_position(name.start_position);
	       eh.append("Bad root procedure name (%"");
	       eh.append(procedure_name);
	       fatal_error("%" is not a creation procedure of this class).");
	    end;
	 end;
      ensure
	 Result /= Void
      end;

feature {SMALL_EIFFEL}

   root_procedure(procedure_name: SIMPLE_FEATURE_NAME): PROCEDURE is
	 -- Look for the root procedure to start execution here.
	 -- Do some checking on the root class (not deferred, not generic,
	 -- really has `procedure_name' as a creation procedure etc.).
	 -- Return Void and print errors if needed.
      require
	 procedure_name = root_procedure_name(procedure_name.to_string)
      local
	 rc: RUN_CLASS;
	 f: E_FEATURE;
      do
	 if is_generic then
	    eh.append(name.to_string);
	    eh.append(" cannot be a root class since it is a generic class.");
	    eh.print_as_fatal_error;
	 end;
	 if is_deferred then
	    eh.append(name.to_string);
	    eh.append(" cannot be a root class since it is a deferred class.");
	    eh.print_as_warning;
	 end;
	 rc := small_eiffel.run_class_for(name.to_string);
	 rc.set_at_run_time;
	 f := look_up_for(rc,procedure_name);
	 if f = Void then
	    eh.add_position(procedure_name.start_position);
	    fatal_error("Root procedure not found.");
	 end;
	 Result ?= f;
	 if Result = Void then
	    eh.add_position(f.start_position);
	    fatal_error("Invalid Root. Only procedure are allowed (VGCC.6).");
	 end;
      ensure
	 Result /= Void
      end;

   check_generic_formal_arguments is
      do
	 if formal_generic_list /= Void then
	    formal_generic_list.check_generic_formal_arguments;
	 end;
      end;

   id_extra_information(sfw: STD_FILE_WRITE) is
      do
	 sfw.put_string("class-name: ");
	 sfw.put_string(name.to_string);
	 sfw.put_string(" parent-count: ");
	 if parent_list /= Void then
	    parent_list.id_extra_information(sfw);
	 else
	    sfw.put_string("0 ");
	 end;
      end;

feature 

   is_generic: BOOLEAN is
	 -- When class is defined with generic arguments.
      do
	 Result := formal_generic_list /= Void;
      end;

   proper_has(fn: FEATURE_NAME): BOOLEAN is
	 -- True when `fn' is really written in current class.
      do
	 Result := feature_dictionary.has(fn.to_key);
      end;

   is_subclass_of(other: BASE_CLASS): BOOLEAN is
	 -- Is Current a subclass of `other' ?
      require
	 other /= Current
      do
	 if other.is_any then
	    Result := true;
	 elseif other.is_platform then
	    Result := true;
	 elseif parent_list /= Void then
	    Result := parent_list.has_parent(other);
	 elseif other.is_general then
	    Result := true;
	 elseif other.is_none then
	 elseif is_none then
	    Result := true;
	 end;
      end;

feature {PARENT_LIST,BASE_CLASS}

   inherit_cycle_check is
      local
	 i: INTEGER;
      do
	 visited.add_last(Current);
	 if visited.first = Current then
	    eh.append("Cyclic inheritance graph : ");
	    from
	       i := 0;
	    until
	       i > visited.upper
	    loop
	       eh.append(visited.item(i).name.to_string);
	       if i < visited.upper then
		  eh.append(", ");
	       end;
	       i := i + 1;
	    end;
	    fatal_error(", ...");
	 elseif parent_list /= Void then
	    parent_list.inherit_cycle_check;
	 end;
      end;

feature

   is_any: BOOLEAN is
	 -- Is it the ANY class ?
      do
	 Result := name.to_string = as_any;
      end;

   is_general: BOOLEAN is
	 -- Is it the GENERAL class ?
      do
	 Result := name.to_string = as_general;
      end;

   is_platform: BOOLEAN is
	 -- Is it the PLATFORM class ?
      do
	 Result := name.to_string = as_platform;
      end;

   is_none: BOOLEAN is
	 -- Is it the NONE class ?
      do
	 Result := name.to_string = as_none;
      end;

   has_redefine(fn: FEATURE_NAME): BOOLEAN is
      require
	 fn /= Void
      do
	 if parent_list /= Void then
	    Result := parent_list.has_redefine(fn)
	 end;
      end;

   e_feature(fn: FEATURE_NAME): E_FEATURE is
	 -- Simple (and fast) look_up to see if `fn' exists here.
      local
	 key: STRING;
      do
	 key := fn.to_key;
	 if feature_dictionary.has(key) then
	    Result := feature_dictionary.at(key);
	 else
	    Result := super_e_feature(fn);
	 end;
      end;

   has(fn: FEATURE_NAME): BOOLEAN is
	 -- Simple (and fast) look_up to see if `fn' exists here.
      require
	 fn /= Void
      do
	 Result := e_feature(fn) /= Void;
      end;

feature {CALL_PROC_CALL}

   run_feature_for(rc: RUN_CLASS; target: EXPRESSION; 
		   fn: FEATURE_NAME; ct: TYPE): RUN_FEATURE is
	 -- Fetch the corresponding one in context `ct' (the type of Current).
	 -- Exporting rules are automatically checked and possible
	 -- rename are also done.
	 -- No return when an error occurs because `fatal_error' is called.
      require
	 target.result_type.base_class = Current
      local
	 top_bc: BASE_CLASS;
	 nfn: FEATURE_NAME;
	 bcn: CLASS_NAME;
      do
	 check  
	    fn.to_string /= as_eq;
	    fn.to_string /= as_neq;
	 end;
	 -- Compute possible rename first:
	 if target.result_type.is_like_current then
	    top_bc := target.start_position.base_class;
	    nfn := ct.base_class.new_name_of(top_bc,fn);
	 else
	    nfn := fn;
	    top_bc := target.static_result_base_class;
	    if top_bc /= Void then
	       if Current = top_bc or else is_subclass_of(top_bc) then
		  if top_bc.has(fn) then
		     nfn := new_name_of(top_bc,fn);
		  end;
	       end;
	    end;
	 end;
	 -- Search for the feature:
	 Result := rc.get_feature(nfn);
	 if Result = Void then
	    eh.feature_not_found(fn);
	    eh.print_as_fatal_error;
	 end;
	 -- Check export rules :
	 if not target.is_current then
	    bcn := ct.base_class.name;
	    if not Result.is_exported_in(bcn) then
	       eh.add_position(Result.start_position);
	       eh.append(" Cannot use feature %"");
	       eh.append(fn.to_string);
	       error(fn.start_position,"%" here.");
	       eh.add_position(fn.start_position);
	       eh.append("Forbidden call when type of Current is ");
	       eh.append(ct.run_time_mark);
	       fatal_error(fz_dot);
	    end;
	 end;
	 -- Finally, check for obsolete usage :
	 Result.base_feature.check_obsolete(fn.start_position);
      ensure
	 Result /= Void
      end;

feature {LOCAL_ARGUMENT,RUN_CLASS}

   has_simple_feature_name(sfn: STRING): BOOLEAN is
	 -- Simple (and fast) look_up to see if one feature of name
	 -- `n' exists here.
      require
	 sfn = string_aliaser.item(sfn)
      local
	 unknown_position: POSITION;
      do
	 mem_fn.make(sfn,unknown_position);
	 Result := has(mem_fn);
      end;

feature {BASE_CLASS,PARENT,RUN_CLASS}

   look_up_for(rc: RUN_CLASS; fn: FEATURE_NAME): E_FEATURE is
	 -- Gives Void or the good one to compute the runnable
	 -- version of `fn' in `rc'.
	 -- All inheritance rules are checked.
      local
	 super: E_FEATURE;
	 fn_key: STRING;
	 cst_att: CST_ATT;
	 fnl: FEATURE_NAME_LIST;
	 super_fn: like fn;
	 i: INTEGER;
      do
	 fn_key := fn.to_key;
	 if feature_dictionary.has(fn_key) then
	    Result := feature_dictionary.at(fn_key);
	    super :=  super_look_up_for(rc,fn);
	    if super /= Void then
	       vdrd6(rc,super,Result);
	       cst_att ?= super;
	       if cst_att /= Void then
		  eh.add_position(super.start_position);
		  eh.add_position(Result.start_position);
		  fatal_error("Constant feature cannot be redefined.");
	       end;
	       from
		  fnl := super.names;
		  i := fnl.count;
	       until
		  i < 1
	       loop
		  super_fn := fnl.item(i)
		  if super_fn.is_frozen then
		     if super_fn.to_key = fn_key then
			eh.add_position(super_fn.start_position);
			eh.add_position(Result.start_position);
			fatal_error("Cannot redefine a frozen feature.");
		     end;
		  end;
		  i := i - 1;
	       end;
	       if not Result.can_hide(super,rc) then
		  eh.add_position(super.start_position);
		  eh.add_position(Result.start_position);
		  eh.append("Incompatible headings for redefinition.");
		  eh.print_as_warning;
	       end;
	       if super.is_deferred then
	       elseif has_redefine(fn) then
	       else
		  eh.add_position(Result.start_position);
		  eh.add_position(super.start_position);
		  eh.append("Invalid redefinition in ");
		  eh.append(name.to_string);
		  eh.append(". Missing redefine ?");
		  eh.print_as_error;
	       end;
	    end;
	 else
	    Result := super_look_up_for(rc,fn);
	 end;
      end;

feature {NONE}

   super_look_up_for(rc: RUN_CLASS; fn: FEATURE_NAME): E_FEATURE is
	 -- Same work as `look_up_for' but do not look in current
	 -- base class.
      require
	 rc /= Void;
	 fn /= Void
      do
	 if parent_list = Void then
	    if not is_general then
	       Result := class_any.look_up_for(rc,fn);
	    end;
	 else
	    Result := parent_list.look_up_for(rc,fn);
	 end;
      end;

feature {RUN_CLASS,PARENT_LIST}

   collect_invariant(rc: RUN_CLASS) is
      require
	 rc /= Void
      do
	 if parent_list /= Void then
	    parent_list.collect_invariant(rc);
	 end;
	 if class_invariant /= Void then
	    assertion_collector.invariant_add_last(class_invariant);
	 end;
      end;

feature {CLASS_INVARIANT,PARENT_LIST}

   header_comment_for(ci: CLASS_INVARIANT) is
      local
	 ia: like class_invariant;
      do
	 ia := class_invariant;
	 if ia /= Void and then ia.header_comment /= Void then
	    ci.set_header_comment(ia.header_comment);
	 elseif parent_list /= Void then
	    parent_list.header_comment_for(ci);
	 end;
      end;

feature {RUN_FEATURE}

   run_require(rf: RUN_FEATURE): RUN_REQUIRE is
	 -- Collect all (inherited) require assertions for `rf'.
      require
	 rf.current_type.base_class = Current
      local
	 ct: TYPE;
      do
	 assertion_collector.require_start;
	 ct := rf.current_type;
	 collect_assertion(rf.name);
	 Result := assertion_collector.require_end(rf,ct);
      end;

   run_ensure(rf: RUN_FEATURE): E_ENSURE is
	 -- Collect all (inherited) ensure assertions for `rf'.
      require
	 rf.current_type.base_class = Current
      local
	 ct: TYPE;
      do
	 assertion_collector.ensure_start;
	 ct := rf.current_type;
	 collect_assertion(rf.name);
	 Result := assertion_collector.ensure_end(rf,ct);
      end;

feature {BASE_CLASS,PARENT_LIST}

   collect_assertion(fn: FEATURE_NAME) is
      require
	 fn /= Void
      local
	 fn_key: STRING;
	 ef: E_FEATURE;
      do
	 fn_key := fn.to_key;
	 if feature_dictionary.has(fn_key) then
	    ef := feature_dictionary.at(fn_key);
	    assertion_collector.assertion_add_last(ef);
	 end;
	 if parent_list = Void then
	    if not is_general then
	       class_any.collect_assertion(fn);
	    end;
	 else
	    parent_list.collect_assertion(fn);
	 end;
      end;

feature {NONE}

   mem_fn: SIMPLE_FEATURE_NAME is
	 -- Dummy once name to avoid memory leaks.
      local
	 unknown_position: POSITION;
      once
	 !!Result.make(as_storage,unknown_position);
      end;

feature {BASE_CLASS}

   super_e_feature(fn: FEATURE_NAME): E_FEATURE is

      do
	 if parent_list = Void then
	    if not is_general then
	       Result := class_any.e_feature(fn);
	    end;
	 else
	    Result := parent_list.e_feature(fn);
	 end;
      end;

feature

   pretty_print is
      do
	 fmt.set_indent_level(0);
	 if index_list /= Void then
	    index_list.pretty_print;
	    fmt.indent;
	 end;
	 if heading_comment1 /= Void then
	    heading_comment1.pretty_print;
	    fmt.indent;
	 end;
	 if is_deferred then
	    fmt.keyword("deferred");
	 elseif is_expanded then
	    fmt.keyword(fz_expanded);
	    end;
	    fmt.keyword("class");
	    name.pretty_print;
	    if is_generic then
	       formal_generic_list.pretty_print;
	    end;
	    fmt.indent;
	    if obsolete_type_string /= Void then
	       fmt.keyword("obsolete");
	       obsolete_type_string.pretty_print;
	    end;
	    fmt.indent;
	    if heading_comment2 /= Void then
	       heading_comment2.pretty_print;
	    end;
	    if parent_list /= Void then
	       parent_list.pretty_print;
	    end;
	    if creation_clause_list /= Void then
	       creation_clause_list.pretty_print;
	    end;
	    if feature_clause_list /= Void then
	       feature_clause_list.pretty_print;
	    end;
	    if class_invariant /= Void then
	       class_invariant.pretty_print;
	    end;
	    fmt.set_indent_level(0);
	    if fmt.zen_mode then
	       fmt.skip(0);
	    else
	       fmt.skip(1);
	    end;
	    fmt.keyword(fz_end);
	    if end_comment /= Void and then not end_comment.dummy then
	       end_comment.pretty_print;
	    elseif not fmt.zen_mode then
	       fmt.put_string("-- class ");
	       fmt.put_string(name.to_string);
	    end;
	    if fmt.column /= 1 then
	       fmt.put_character('%N');
	    end;
	 end;

feature {NONE}

   error_vtec1 is
      do
	 error(name.start_position,
	       "A class cannot be expanded and deferred (VTEC.1).");
      end;

feature {FEATURE_NAME,E_FEATURE}

   fatal_undefine(fn: FEATURE_NAME) is
      do
	 eh.append("Problem with undefine of %"");
	 eh.append(fn.to_string);
	 eh.append("%" in %"");
	 eh.append(name.to_string);
	 fatal_error("%".");
      end;

feature {TYPE,PARENT}

   is_a_vncg(t1, t2: TYPE): BOOLEAN is
	 -- Direct conformance VNCG
      require
	 t1.is_run_type;
	 t2.is_run_type;
	 t1.base_class = Current;
	 t2.generic_list /= Void;
	 eh.is_empty
      do
	 if parent_list /= Void then
	    Result := parent_list.is_a_vncg(t1.run_type,t2.run_type);
	 end;
      ensure
	 eh.is_empty
      end;

feature {NONE}

   visited: FIXED_ARRAY[BASE_CLASS] is
	 -- List of all visited classes for the `inherit_cycle_check'.
      once
	 !!Result.with_capacity(32);
      end;

   vdrd6(rc: RUN_CLASS; super, redef: E_FEATURE) is
      require
	 super /= Void;
	 redef /= Void;
	 super /= redef
      local
	 writable_attribute: WRITABLE_ATTRIBUTE;
	 ct, rt1, rt2: TYPE;
      do
	 writable_attribute ?= super;
	 if writable_attribute /= Void then
	    writable_attribute ?= redef;
	    if writable_attribute = Void then
	       fatal_error_vdrd6(super,redef,
				 "An attribute must be redefined as an attribute %
				 %only (VDRD.6).");
	    else
	       ct := rc.current_type;
	       rt1 := super.result_type.to_runnable(ct);
	       rt2 := redef.result_type.to_runnable(ct);
	       if rt1.is_reference then
		  if rt2.is_reference then
		  else
		     fatal_error_vdrd6(super,redef,vdrd6_types);
		  end;
	       elseif rt2.is_reference then
		  fatal_error_vdrd6(super,redef,vdrd6_types);
	       end;
	    end;
	 end;
      end;

   vdrd6_types: STRING is "Result types must be both expanded or %
   %both non-expanded (VDRD.6)."

   fatal_error_vdrd6(super, redef: E_FEATURE; msg: STRING) is
      do
	 eh.add_position(super.start_position);
	 eh.add_position(redef.start_position);
	 eh.append("Bad redefinition. ");
	 eh.append(msg);
	 eh.print_as_fatal_error;
      end;

invariant

   name /= Void;

end -- BASE_CLASS
