--          This file is part of SmartEiffel The GNU Eiffel Compiler.
--       Copyright (C) 1994-2002 LORIA - INRIA - U.H.P. Nancy 1 - FRANCE
--          Dominique COLNET and Suzanne COLLIN - SmartEiffel@loria.fr
--                       http://SmartEiffel.loria.fr
-- SmartEiffel 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. SmartEiffel 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  SmartEiffel;  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
   HASHABLE redefine is_equal end
   GLOBALS
   ASSERTION_LEVEL_NUMBERING

creation {EIFFEL_PARSER} make

creation {TYPE_TUPLE, SMART_EIFFEL} face_class

feature

   id: INTEGER
	 -- To produce compact C code.

   path: STRING
	 -- Access to the corresponding file (full file path).

   cluster: CLUSTER
	 -- The `cluster' used to load the class (also gives acces to
	 -- the directory path).

   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.

   is_separate: BOOLEAN
         -- True if the class itself is separate. See scoop.html

   maybe_separate: BOOLEAN
         -- True if some entity uses that class as separate (i.e. some
         -- TYPE_SEPARATE object exists.) See scoop.html

   name: CLASS_NAME
	 -- The short name of the class (no `cluster' name included).

   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.

   assertion_level: INTEGER
	 -- The one `Current' (mangled using ASSERTION_LEVEL_NUMBERING).

   sedb_trace: BOOLEAN
	 -- Is the -sedb run-time trace mechanism activated for the
	 -- `Current' class?

   require_check: BOOLEAN is
	 -- Is `Current' in -require_check mode ?
      do
	 if assertion_level = level_unknown then
	    assertion_level := ace.assertion_level_of(Current)
	 end
	 Result := assertion_level >= level_require
      end

   ensure_check: BOOLEAN is
	 -- Is `Current' in -ensure_check mode ?
      do
	 if assertion_level = level_unknown then
	    assertion_level := ace.assertion_level_of(Current)
	 end
	 Result := assertion_level >= level_ensure
      end

   invariant_check: BOOLEAN is
	 -- Is `Current' in -invariant_check mode ?
      do
	 if assertion_level = level_unknown then
	    assertion_level := ace.assertion_level_of(Current)
	 end
	 Result := assertion_level >= level_invariant
      end

   loop_check: BOOLEAN is
	 -- Is `Current' in -loop_check mode ?
      do
	 if assertion_level = level_unknown then
	    assertion_level := ace.assertion_level_of(Current)
	 end
	 Result := assertion_level >= level_loop
      end

   all_check: BOOLEAN is
	 -- Is `Current' in -all_check mode ?
      do
	 if assertion_level = level_unknown then
	    assertion_level := ace.assertion_level_of(Current)
	 end
	 Result := assertion_level >= level_all
      end

   a_default_create(type: E_TYPE): RUN_FEATURE_3 is
	 -- When the corresponding `base_class' has a `default_create' or
	 -- to get the creation procedure of and expanded class.
      require
	 type.base_class = Current
      do
	 if creation_clause_list /= Void then
	    Result := creation_clause_list.a_default_create(type)
	 end
      end

   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
	       error_handler.add_position(top_fn.start_position)
	       error_handler.append(fz_09)
	       error_handler.append(top_fn.to_string)
	       error_handler.append("%" from %"")
	       error_handler.append(top.name.to_string)
	       error_handler.append("%" not found in %"")
	       error_handler.append(name.to_string)
	       error_handler.append("%".")
	       error_handler.print_as_fatal_error
	    end
	 end
      ensure
	 Result /= Void
      end

   get_copy: E_FEATURE is
      do
	 fn_buffer.unknown_position(as_copy)
	 Result := feature_dictionary.at(fn_buffer)
      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.
      local
	 f: E_FEATURE
      do
	 f := feature_dictionary.reference_at(fn)
	 if f /= Void then
	    Result := f.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;
	 cl: CLIENT_LIST
      do
	 if creation_clause_list = Void then
	    error_handler.append(name.to_string)
	    error_handler.append(once " has no creation clause. This creation %
                           %call is thus not allowed.")
	    error_handler.add_position(proc_name.start_position)
	    error_handler.print_as_error
	 else
	    cc := creation_clause_list.get_clause(proc_name)
	    if cc = Void then
	       error_handler.append(fz_09)
	       error_handler.append(proc_name.to_string)
	       error_handler.append(once "%" does not belong to a creation clause of ")
	       error_handler.append(name.to_string)
	       error_handler.add_position(proc_name.start_position)
	       error_handler.append(". This creation call is thus not allowed.")
	       error_handler.print_as_error
	    else
	       Result := True
	       bc := proc_name.origin_base_class
	       if bc /= Void then
		  cn := bc.name
		  cl := cc.clients
		  Result := cl.gives_permission_to(cn)
		  if not Result then
		     error_handler.add_position(proc_name.start_position)
		     error_handler.append("Forbidden creation call (i.e. exportation %
			       %rules violated). Creation is only allowed %
			       %from ")
		     error_handler.append(cl.eiffel_view)
		     cl.locate_in_error_handler
		     error_handler.extend('.')
		     error_handler.print_as_error
		  end
	       end
	    end
	 end
      end

   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)
      end

   is_subclass_of(other: BASE_CLASS): BOOLEAN is
	 -- Is Current a subclass of `other' ?
      require
	 other /= Current
      local
	 other_name: STRING
      do
	 if is_subclass_of_memory.has(other) then
	    Result := is_subclass_of_memory.at(other)
	 else
	    other_name := other.name.to_string
	    if other_name = as_any then
	       Result := True
	    elseif other_name = as_platform then
	       Result := True
	    elseif parent_list /= Void then
	       Result := parent_list.has_parent(other)
	    elseif other_name = as_general then
	       Result := True
	    elseif other_name = as_none then
	    elseif is_none then
	       Result := True
	    end
	    is_subclass_of_memory.add(Result,other)
	 end
      end

   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.
      do
	 Result := feature_dictionary.reference_at(fn)
	 if Result = Void then
	    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

   hash_code: INTEGER
	 -- Actually, in order to speed up the compiler, this is a cache
	 -- for value `name.to_string.hash_code'.

   is_equal(other: like Current): BOOLEAN is
      do
	 Result := Current = other
      end

   pretty_print is
      do
	 pretty_printer.set_indent_level(0)
	 if index_list /= Void then
	    index_list.pretty_print
	    pretty_printer.indent
	 end
	 if heading_comment1 /= Void then
	    heading_comment1.pretty_print
	    pretty_printer.indent
	 end
	 if is_deferred then
	    pretty_printer.keyword(once "deferred")
	 elseif is_expanded then
	    pretty_printer.keyword(fz_expanded)
	    end
	    pretty_printer.keyword(once "class")
	    name.pretty_print
	    if is_generic then
	       formal_generic_list.pretty_print
	    end
	    pretty_printer.indent
	    if obsolete_type_string /= Void then
	       pretty_printer.keyword(once "obsolete")
	       obsolete_type_string.pretty_print
	    end
	    pretty_printer.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
	    pretty_printer.set_indent_level(0)
	    if pretty_printer.zen_mode then
	       pretty_printer.skip(0)
	    else
	       pretty_printer.skip(1)
	    end
	    pretty_printer.keyword(fz_end)
	    if end_comment /= Void and then not end_comment.dummy then
	       end_comment.pretty_print
	    elseif not pretty_printer.zen_mode then
	       pretty_printer.put_string(once "-- class ")
	       pretty_printer.put_string(name.to_string)
	    end
	    if pretty_printer.column /= 1 then
	       pretty_printer.put_character('%N')
	    end
	 end

feature {TYPE_SEPARATE}

   set_maybe_separate is
      do
         if is_expanded then
            error(name.start_position,
                  once "An expanded class cannot be separate.")
         end
         maybe_separate := True
      end

feature {TYPE_CLASS}

   smallest_ancestor(type, other: E_TYPE): E_TYPE is
	 -- To help implementation of E_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
      local
	 c1, c2: INTEGER; bc2: BASE_CLASS; pl1, pl2: like parent_list
      do
	 if is_any then
	    Result := type
	 elseif type.run_time_mark = other.run_time_mark then
	    Result := type
	 else
	    pl1 := parent_list
	    if pl1 = Void then
	       Result := type_any
	    else
	       bc2 := other.base_class
	       pl2 := bc2.parent_list
	       if pl2 = Void then
		  Result := type_any
	       else
		  c1 := pl1.count
		  c2 := pl2.count
		  if c1 < c2 then
		     Result := pl1.smallest_ancestor(type,other)
		  else
		     Result := pl2.smallest_ancestor(other,type)
		  end
	       end
	    end
	 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 {RUN_CLASS}

   get_default_rescue(rc: RUN_CLASS; n: FEATURE_NAME): RUN_FEATURE_3 is
      local
	 general: BASE_CLASS; p: E_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(type: E_TYPE) is
      require
	 type.is_expanded
	 type.base_class = Current
      local
	 rf: RUN_FEATURE
      do
	 if is_deferred then
	    error_handler.add_type(type,fz_is_invalid)
	    error_handler.append(
               " A deferred class must not be expanded (VTEC.1).")
	    error_handler.print_as_fatal_error
	 end
	 if creation_clause_list /= Void then
	    creation_clause_list.check_expanded_with(type)
	 end
	 rf := a_default_create(type)
      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)
	 smart_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 {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 {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)
      local
	 dico: DICTIONARY[FEATURE_NAME,BASE_CLASS]
      do
	 if ace.high_memory_compiler then
	    dico := up_to_original_memory.reference_at(top_fn)
	    if dico = Void then
	       create dico.make
	       up_to_original_memory.add(dico,top_fn)
	    end
	    Result := dico.reference_at(bottom)
	    if Result = Void then
	       Result := up_to_original_(bottom,top_fn)
	       dico.put(Result,bottom)
	    end
	 else
	    Result := up_to_original_(bottom,top_fn)
	 end
      end

feature {NONE}

   up_to_original_memory:
      DICTIONARY[DICTIONARY[FEATURE_NAME,BASE_CLASS],FEATURE_NAME]

   up_to_original_(bottom: BASE_CLASS; top_fn: FEATURE_NAME): FEATURE_NAME is
      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
	       error_handler.add_position(bottom_fn.start_position)
	       error_handler.append(top.name.to_string)
	       error_handler.append(once "<---")
	       error_handler.append(name.to_string)
	       error_handler.append(once ". BASE_CLASS.original_name, Not Yet Implemented.")
	       error_handler.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
	 else
	    check not is_general end
	    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: E_PROCEDURE is
      do
	 fn_buffer.unknown_position(as_default_rescue)
	 if feature_dictionary.has(fn_buffer) then
	    Result ?= feature_dictionary.at(fn_buffer)
	 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

   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 := once "        "
	 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
         elseif is_separate then
            error(name.start_position,
                  once "A class cannot be separate and deferred.")
	 end
	 is_deferred := True
      end

   set_is_expanded is
      do
	 if is_deferred then
	    error_vtec1
         elseif is_separate then
            error(name.start_position,
                  once "A class cannot be separate and expanded.")
	 end
	 is_expanded := True
      end

   set_is_separate is
      do
         if is_expanded then
            error(name.start_position,
                  once "A class cannot be separate and expanded.")
         elseif is_deferred then
            error(name.start_position,
                  once "A class cannot be separate and deferred.")
         end
         is_separate := True
         set_maybe_separate
      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
      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
	    if not smart_eiffel.pretty_flag then
	       parent_list.get_started
	    end
	 end
	 if end_comment /= Void then
	    end_comment.good_end(name)
	 end
	 if parent_list /= Void then
	    if not smart_eiffel.pretty_flag then
	       visited.clear
	       visited.add_last(Current)
	       parent_list.inherit_cycle_check
	    end
	 end
	 if is_deferred and then creation_clause_list /= Void then
	    error_handler.add_position(name.start_position)
	    warning(creation_clause_list.start_position,
		    once "Deferred class should not have %
		    %creation clause (VGCP.1).")
	 end
	 sedb_trace := ace.trace_of(Current)
      end

feature {ACE}

   default_root_procedure_name: STRING is
	 -- Return the default creation procedure name to be used as the root
	 -- procedure (the execution entry point of the system).
      do
	 fatal_error_when_no_creation_clause
	 Result := creation_clause_list.default_root
      ensure
	 Result /= Void
      end

feature {SMART_EIFFEL}

   root_creation_search(a_name: STRING): FEATURE_NAME is
	 -- Check that `a_name' is actually member of some creation clause.
      require
	 not a_name.is_empty
      do
	 fatal_error_when_no_creation_clause
	 Result := creation_clause_list.root_creation_search(a_name)
	 if Result = Void then
	    error_handler.add_position(name.start_position)
	    error_handler.append("Bad root procedure name (%"")
	    error_handler.append(a_name)
	    error_handler.append(
               "%" is not a creation procedure of this class).")
	    error_handler.print_as_fatal_error
	 end
      ensure
	 Result.is_simple_feature_name
      end

   root_procedure_check(procedure_name: FEATURE_NAME): E_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_creation_search(procedure_name.to_string)
      local
	 rc: RUN_CLASS; f: E_FEATURE
      do
	 if is_generic then
	    error_handler.append(name.to_string)
	    error_handler.append(
               " cannot be a root class since it is a generic class.")
	    error_handler.print_as_fatal_error
	 end
	 if is_deferred then
	    error_handler.append(name.to_string)
	    error_handler.append(
               " cannot be a root class since it is a deferred class.")
	    error_handler.print_as_warning
	 end
	 rc := smart_eiffel.run_class_for(name)
	 rc.set_at_run_time
	 f := look_up_for(rc,procedure_name)
	 if f = Void then
	    error_handler.add_position(procedure_name.start_position)
	    error_handler.append("Root procedure not found.")
	    error_handler.print_as_fatal_error
	 end
	 Result ?= f
	 if Result = Void then
	    error_handler.add_position(f.start_position)
	    error_handler.append(
               "Invalid Root. Only procedure are allowed (VGCC.6).")
	    error_handler.print_as_fatal_error
	 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(tfw: TEXT_FILE_WRITE) is
      do
	 tfw.put_string(once "class-name: ")
	 tfw.put_string(name.to_string)
	 tfw.put_string(once "%Nparent-count: ")
	 if parent_list /= Void then
	    parent_list.id_extra_information(tfw)
	 else
	    tfw.put_character('0')
	 end
	 tfw.put_character('%N')
      end

   obsolete_warning(client_name: CLASS_NAME) is
      require
	 client_name.to_string = name.to_string
      do
   	 if obsolete_type_string /= Void then
	    if smart_eiffel.short_flag then
	    elseif smart_eiffel.pretty_flag then
	    else
	       error_handler.add_position(client_name.start_position)
	       error_handler.append(once "Class ")
	       error_handler.append(name.to_string)
	       error_handler.append(once " is obsolete :%N")
	       error_handler.append(obsolete_type_string.to_string)
	       error_handler.add_position(name.start_position)
	       error_handler.print_as_warning
	    end
	 end
      end

feature {PARENT_LIST,BASE_CLASS}

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

feature {CALL_PROC_CALL,E_AGENT}

   run_feature_for(rc: RUN_CLASS; target: EXPRESSION
		   fn: FEATURE_NAME; ct: E_TYPE): RUN_FEATURE is
	 -- Fetch the corresponding one in `rc' when the context is `ct'
	 -- (the context is 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
	 -- This should be True ....
	 ---
	 target.result_type.run_class = rc
	 rc.base_class = Current
	 not fn.start_position.is_unknown
      local
	 top_bc, bc: BASE_CLASS; lfn, nfn: FEATURE_NAME; bcn: CLASS_NAME
	 target_type: E_TYPE; lf: E_FEATURE; tlf: TYPE_LIKE_FEATURE
	 cl: CLIENT_LIST
      do
	 check
	    fn.to_string /= as_eq
	    fn.to_string /= as_neq
	 end
	 -- Compute possible rename first:
	 nfn := fn
	 target_type := target.result_type
	 if target_type.is_like_current and then
	    target_type.run_time_mark = ct.run_time_mark
	  then
	    top_bc := target.start_position.base_class
	    check
	       ct.base_class = Current
	    end
	    nfn := new_name_of(top_bc,fn)
	 elseif target_type.is_like_feature then
	    tlf ?= target_type
	    lfn := tlf.like_what
	    bc := lfn.start_position.base_class
	    lf := bc.e_feature(lfn)
	    top_bc := lf.result_type.start_lookup_class
	    if top_bc /= Void then
	       bc := target.result_type.base_class
	       if bc = top_bc or else bc.is_subclass_of(top_bc) then
		  if top_bc.has(fn) then
		     nfn := bc.new_name_of(top_bc,fn)
		  end
	       end
	    end
	 else
	    top_bc := target.start_lookup_class
	    if top_bc /= Void then
	       if Current = top_bc or else Current.is_subclass_of(top_bc) then
		  if top_bc.has(fn) then
		     nfn := Current.new_name_of(top_bc,fn)
		  end
	       end
	    end
	 end
	 check nfn /= Void end
	 -- Search for the feature:
	 Result := rc.get_feature(nfn)
	 if Result = Void then
	    error_handler.feature_not_found(fn)
	    error_handler.print_as_fatal_error
	 end
	 -- Check export rules:
	 if not target.is_current then
	    bcn := ct.base_class.name
	    cl := Result.clients
	    if not cl.gives_permission_to(bcn) then
	       error_handler.add_position(fn.start_position)
	       error_handler.append(
                  "Forbidden call (i.e. exportation rules violated) %
		  %when the type of Current is ")
	       error_handler.append(ct.run_time_mark)
	       error_handler.append(
                  ". (See the next error report for details.)")
	       error_handler.print_as_error
	       error_handler.add_position(Result.start_position)
	       error_handler.append("This feature is only exported to ")
	       error_handler.append(cl.eiffel_view)
	       cl.locate_in_error_handler
	       error_handler.extend('.')
	       error_handler.print_as_fatal_error
	    end
	 end
	 -- Finally, check for obsolete usage:
	 Result.base_feature.check_obsolete(fn.start_position)
      ensure
	 Result.run_class = rc
      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)
      do
	 fn_buffer.unknown_position(sfn)
	 Result := has(fn_buffer)
      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; cst_att: CST_ATT; fnl: FEATURE_NAME_LIST
	 super_fn: like fn; i: INTEGER
	 writable_attribute: WRITABLE_ATTRIBUTE
      do
	 Result := feature_dictionary.reference_at(fn)
	 if Result /= Void then
	    super :=  super_look_up_for(rc,fn)
	    if super /= Void then
	       vdrd6(rc,super,Result)
	       cst_att ?= super
	       if cst_att /= Void then
		  error_handler.add_position(super.start_position)
		  error_handler.add_position(Result.start_position)
		  error_handler.append(
                     "Constant feature cannot be redefined.")
		  error_handler.print_as_fatal_error
	       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.to_key then
			error_handler.add_position(super_fn.start_position)
			error_handler.add_position(Result.start_position)
			error_handler.append(
                           "Cannot redefine a frozen feature.")
			error_handler.print_as_fatal_error
		     end
		  end
		  i := i - 1
	       end
	       if not Result.can_hide(super,rc) then
		  writable_attribute ?= Result
		  if writable_attribute /= Void and then
		     writable_attribute.is_item_of_integer
		   then
		     -- The rule is relaxed for INTEGER_*.item definition.
		  else
		     error_handler.add_position(super.start_position)
		     error_handler.add_position(Result.start_position)
		     error_handler.append(
		        "Incompatible headings for redefinition.")
		     error_handler.add_context_info(rc.current_type)
		     error_handler.print_as_fatal_error
		  end
	       end
	       if super.is_deferred then
	       elseif has_redefine(fn) then
	       else
		  error_handler.add_position(Result.start_position)
		  error_handler.add_position(super.start_position)
		  error_handler.append("Invalid redefinition in ")
		  error_handler.append(name.to_string)
		  error_handler.append(". Missing redefine ?")
		  error_handler.print_as_error
	       end
	    end
	 else
	    Result := super_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: E_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: E_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
	 ef: E_FEATURE
      do
	 ef := feature_dictionary.reference_at(fn)
	 if ef /= Void then
	    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 {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 {FEATURE_NAME,E_FEATURE}

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

feature {E_TYPE, PARENT}

   is_a_vncg(t1, t2: E_TYPE): BOOLEAN is
	 -- Direct conformance of generic classes VNCG.
      require
	 t1.is_run_type
	 t2.is_run_type
	 t1.base_class = Current
	 t2.base_class /= Current
	 t2.generic_list /= Void
	 error_handler.is_empty
      do
	 if parent_list /= Void then
	    Result := parent_list.is_a_vncg(t1.run_type,t2.run_type)
	 end
      ensure
	 error_handler.is_empty
      end

feature {RUN_TIME_SET, PARENT}

   graph_node_vncg_update(site: POSITION; t1, t2: E_TYPE): BOOLEAN is
	 -- To update the assignment graph node for generic arguments.
      require
	 t1.run_type.is_a(t2.run_type)
	 t1.base_class = Current
	 t2.base_class /= Current
	 t2.generic_list /= Void
      do
	 check
	    parent_list /= Void
	    t1.run_type = t1
	    t2.run_type = t2
	 end
	 Result := parent_list.graph_node_vncg_update(site,t1,t2)
      end

feature {TYPE_FUNCTION}

   load_feature_item(toa: TYPE_OF_AGENT; rt: E_TYPE) is
      require
	 toa.run_type = toa
	 toa.base_class = Current
	 rt.run_type = rt
      local
	 sp: POSITION; at: TYPE_TUPLE; er: EXTERNAL_FUNCTION
	 n: FEATURE_NAME; arg: ARGUMENT_NAME1
	 fal: FORMAL_ARG_LIST; rf: RUN_FEATURE
      do
	 fn_buffer.unknown_position(as_item)
	 if not feature_dictionary.has(fn_buffer) then
	    -- Creation of the `call' feature:
	    sp.set_in(Current)
	    create arg.make(sp, as_a1)
	    create at.make(sp,Void)
	    create fal.make(<<create {DECLARATION_1}.make(arg,at)>>)
	    create n.simple_feature_name(as_item,sp)
	    create er.make(create {FEATURE_NAME_LIST}.make_1(n),
			   fal,rt,Void,Void,Void,
			   create {NATIVE_SMART_EIFFEL}.default_create,
			   Void)
	    add_feature(er)
	    rf := er.to_run_feature(toa,n)
	 end
      end

feature {TYPE_OF_AGENT}

   load_feature_call(toa: TYPE_OF_AGENT) is
      require
	 toa.run_type = toa
	 toa.base_class = Current
      local
	 sp: POSITION; at: TYPE_TUPLE; er: EXTERNAL_PROCEDURE
	 n: FEATURE_NAME; arg: ARGUMENT_NAME1
	 fal: FORMAL_ARG_LIST; rf: RUN_FEATURE
      do
	 fn_buffer.unknown_position(as_call)
	 if not feature_dictionary.has(fn_buffer) then
	    -- Creation of the `call' feature:
	    sp.set_in(Current)
	    create arg.make(sp, as_a1)
	    create at.make(sp,Void)
	    create fal.make(<<create {DECLARATION_1}.make(arg,at)>>)
	    create n.simple_feature_name(as_call,sp)
	    create er.make(create {FEATURE_NAME_LIST}.make_1(n),
			   fal,Void,Void,Void,
			   create {NATIVE_SMART_EIFFEL}.default_create,
			   Void)
	    add_feature(er)
	    rf := er.to_run_feature(toa,n)
	 end
      end

feature {NONE}

   basic_create is
	 -- Common part to finish all create procedure.
      do
	 hash_code := name.hash_code
	 smart_eiffel.add_base_class(Current)
	 create feature_dictionary.make
	 create is_subclass_of_memory.with_capacity(256)
	 if ace.high_memory_compiler then
	    create up_to_original_memory.with_capacity(1024)
	 end
      end

   add_feature(f: E_FEATURE) is
	 -- To add pseudo features.
      require
	 f.names.count = 1
      do
	 f.set_clients(omitted_client_list)
	 f.add_into(feature_dictionary)
      end

   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.

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

   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

   fn_buffer: FEATURE_NAME is
	 -- Dummy once name to avoid memory leaks.
      once
	 create Result.unknown_position(as_storage)
      end

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

   feature_dictionary: DICTIONARY[E_FEATURE,FEATURE_NAME]
	 -- 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).

   is_subclass_of_memory: DICTIONARY[BOOLEAN,BASE_CLASS]
	 -- This is a memory cache to avoid many recomputation of
	 -- `is_subclass_of'. This is also why the `hash_code' is cached too.

   make(p: like path;  my_name: STRING; c: like cluster; i: like id) is
      require
	 p = string_aliaser.item(p)
	 my_name = string_aliaser.item(my_name)
	 not smart_eiffel.no_file_for(my_name)
	 c /= Void
	 i > 0
      do
	 id := i
	 path := p
	 cluster := c
	 create name.unknown_position(my_name)
	 basic_create
      ensure
	 path = p
	 name.to_string = my_name
	 cluster = c
	 id = i
      end

   face_class(n: STRING) is
	 -- To create some face classes: TUPLE, ROUTINE, PROCEDURE,
	 -- FUNCTION, and PREDICATE.
      require
	 smart_eiffel.no_file_for(n)
      do
	 path := n
	 !!name.unknown_position(n)
	 id := id_provider.item(n)
	 basic_create
      ensure
	 name.to_string = n
      end

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

   fatal_error_when_no_creation_clause is
      do
	 if creation_clause_list = Void then
	    error_handler.add_position(name.start_position)
	    error_handler.append(
               "Bad root class (this class has no creation clause).")
	    error_handler.print_as_fatal_error
	 end
      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: E_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
		  elseif writable_attribute.is_item_of_integer then
		     -- The rule is relaxed for INTEGER_*.item definition.
		  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
	 error_handler.add_position(super.start_position)
	 error_handler.add_position(redef.start_position)
	 error_handler.append("Bad redefinition. ")
	 error_handler.append(msg)
	 error_handler.print_as_fatal_error
      end

   default_rescue_sfn: FEATURE_NAME is
      once
	 !!Result.unknown_position(as_default_rescue)
      end

   copy_sfn: FEATURE_NAME is
      once
	 !!Result.unknown_position(as_copy)
      end

invariant

   name /= Void

   hash_code = name.to_string.hash_code

end -- BASE_CLASS