home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AmigActive 3
/
AACD03.BIN
/
AACD
/
Programming
/
sofa
/
archive
/
SmallEiffel.lha
/
SmallEiffel
/
lib_se
/
base_class.e
< prev
next >
Wrap
Text File
|
1999-06-05
|
34KB
|
1,183 lines
-- 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} 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' of class
-- NAME.
make is
require
eiffel_parser.is_running
do
!!isom.with_capacity(16);
path := string_aliaser.item(parser_buffer.path);
!!name.make_unknown;
!!feature_dictionary.make;
end;
feature {TYPE}
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 is_general then
else
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}
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_flag(mark: STRING): BOOLEAN is
-- Flag used to avoid double C definition of globals
-- C variables for once routines.
require
mark /= Void;
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;
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 the feature down in class
-- hierarchy to 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
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 {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.
-- Thus, in the first call, `top_fn' is the name used in `top'.
require
top.proper_has(top_fn);
Current = top or else Current.is_subclass_of(top);
top_fn /= Void
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;
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: ARRAY[PARENT]) is
require
sp /= Void;
c /= Void or else l /= Void;
l /= Void implies not l.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
id := id_provider.item(name.to_string);
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
has(fn) = (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.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 := run_class;
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 (not a procedure).");
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;
feature
run_class: RUN_CLASS is
require
not is_generic
local
rcd: DICTIONARY[RUN_CLASS,STRING];
n: STRING;
type: TYPE_CLASS;
do
n := name.to_string;
rcd := small_eiffel.run_class_dictionary;
if rcd.has(n) then
Result := rcd.at(n);
else
!!type.make(name);
Result := type.run_class;
end;
end;
current_type: TYPE is
do
Result := run_class.current_type;
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.to_key);
end;
is_subclass_of(other: BASE_CLASS): BOOLEAN is
-- Is Current a subclass of `other' ?
require
other /= Current
do
if isom.fast_has(other) then
Result := true;
else
if other.is_any then
Result := true;
else
visited.clear;
Result := is_subclass_of_aux(other);
end;
if Result then
isom.add_last(other);
end;
end;
end;
feature {NONE}
isom: FIXED_ARRAY[BASE_CLASS];
-- Memorize results to speed ud `is_subclass_of'.
visited: FIXED_ARRAY[BASE_CLASS] is
-- List of all visited classes to detects loops during
-- `is_subclass_of' processing.
once
!!Result.with_capacity(32);
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;
is_subclass_of_aux(c: BASE_CLASS): BOOLEAN is
require
not c.is_any;
Current /= c
do
if visited.fast_has(Current) then
else
visited.add_last(Current);
if parent_list /= Void then
Result := parent_list.has_parent(c);
elseif not visited.fast_has(class_any) then
Result := class_any.is_subclass_of_aux(c);
end;
end;
end;
feature
is_any: BOOLEAN is
do
Result := as_any = name.to_string;
end;
is_general: BOOLEAN is
do
Result := as_general = name.to_string;
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;
constraint: TYPE;
type_formal_generic: TYPE_FORMAL_GENERIC;
bcn: CLASS_NAME;
do
check
fn.to_string /= as_eq;
fn.to_string /= as_neq;
end;
-- Check constrained genericity first :
type_formal_generic ?= target.result_type;
if type_formal_generic /= Void then
constraint := type_formal_generic.constraint;
if constraint = Void then
elseif not type_formal_generic.is_a(constraint) then
eh.print_as_error;
eh.add_position(fn.start_position);
fatal_error("Constraint genericity violation.");
end;
end;
-- Then, compute possible rename :
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;
-- 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)
do
mem_fn.make(sfn,Void);
Result := has(mem_fn);
end;
feature
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 is_general then
Result := Void;
else
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;
do
fn_key := fn.to_key;
if feature_dictionary.has(fn_key) then
assertion_collector.assertion_add_last(feature_dictionary.at(fn_key));
end;
if parent_list = Void then
if is_general then
else
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.
once
!!Result.make(as_malloc,Void);
end;
feature {BASE_CLASS}
super_e_feature(fn: FEATURE_NAME): E_FEATURE is
do
if parent_list = Void then
if is_general then
else
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.empty
do
if parent_list /= Void then
Result := parent_list.is_a_vncg(t1.run_type,t2.run_type);
end;
ensure
eh.empty
end;
feature {NONE}
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
path.count > 0;
name /= Void;
end -- BASE_CLASS