home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
AmigActive 3
/
AACD03.BIN
/
AACD
/
Programming
/
sofa
/
archive
/
SmallEiffel.lha
/
SmallEiffel
/
lib_se
/
parent_list.e
< prev
next >
Wrap
Text File
|
1999-06-05
|
17KB
|
684 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 PARENT_LIST
--
-- To store the parent list of a class.
--
inherit GLOBALS;
creation make
feature
base_class: BASE_CLASS;
-- Where the parent list is written.
start_position: POSITION;
-- Of the keyword "inherit".
heading_comment: COMMENT;
-- Global comment of the inherit clause.
feature {NONE}
list: ARRAY[PARENT];
feature {NONE}
make(bc: like base_class; sp: like start_position;
hc: like heading_comment; l: like list) is
require
bc /= Void;
sp /= Void;
l.lower = 1 and not l.empty;
do
base_class := bc;
heading_comment := hc;
start_position := sp;
list := l;
ensure
base_class = bc;
start_position = sp;
heading_comment = hc;
list = l;
end;
feature
count: INTEGER is
do
Result := list.upper;
end;
up_to_any_in(pl: FIXED_ARRAY[BASE_CLASS]) is
local
i: INTEGER;
p: PARENT;
bc: BASE_CLASS;
do
from
i := list.upper;
until
i = 0
loop
p := list.item(i);
bc := p.base_class;
if not pl.fast_has(bc) then
pl.add_last(bc);
end;
i := i - 1;
end;
from
i := list.upper;
until
i = 0
loop
p := list.item(i);
bc := p.base_class;
if bc /= class_any then
bc.up_to_any_in(pl);
end;
i := i - 1;
end;
end;
base_class_name: CLASS_NAME is
do
Result := base_class.name;
end;
has_redefine(fn: FEATURE_NAME): BOOLEAN is
require
fn /= Void
local
i: INTEGER;
do
from
i := 1;
until
Result or else i > list.upper
loop
Result := list.item(i).has_redefine(fn);
i := i + 1;
end;
end;
feature {BASE_CLASS}
up_to_original(bottom: BASE_CLASS; top_fn: FEATURE_NAME): FEATURE_NAME is
local
p1, p2: PARENT;
fn1, fn2, new_fn: FEATURE_NAME;
i: INTEGER;
do
from
i := list.upper;
until
i = 0 or else fn1 /= Void
loop
p1 := list.item(i);
fn1 := p1.up_to_original(bottom,top_fn);
i := i - 1;
end;
from
until
i = 0
loop
p2 := list.item(i);
fn2 := p2.up_to_original(bottom,top_fn);
if fn2 /= Void then
new_fn := p2.do_rename(top_fn);
if p2.has_select_for(new_fn) then
p1 := p2;
fn1 := fn2;
end;
end;
i := i - 1;
end;
if fn1 /= Void then
if fn1.to_string /= top_fn.to_string then
Result := repeated_inheritance(p1,fn1,top_fn);
else
Result := fn1;
end;
end;
end;
clients_for(fn: FEATURE_NAME): CLIENT_LIST is
require
fn /= Void
local
i: INTEGER;
cl: CLIENT_LIST;
do
from
i := list.upper;
until
i = 0
loop
cl := list.item(i).clients_for(fn);
if Result = Void then
Result := cl;
elseif cl /= Void then
Result := Result.append(cl);
end;
if Result = Void then
i := i - 1;
elseif Result.gives_permission_to_any then
i := 0;
else
eh.cancel;
i := i - 1;
end;
end;
end;
going_up(trace: FIXED_ARRAY[PARENT]; top: BASE_CLASS;
top_fn: FEATURE_NAME;): FEATURE_NAME is
require
top /= Void;
top_fn /= Void
local
i: INTEGER;
p1, p2: PARENT;
fn1, fn2: FEATURE_NAME;
do
from
i := list.upper;
until
fn1 /= Void or else i = 0
loop
p1 := list.item(i);
fn1 := p1.going_up(trace,top,top_fn);
i := i - 1;
end;
from
until
i = 0
loop
p2 := list.item(i);
fn2 := p2.going_up(trace,top,top_fn);
if fn2 /= Void then
if p2.has_select_for(fn2) then
p1 := p2;
fn1 := fn2;
end;
end;
i := i - 1;
end;
Result := fn1;
end;
is_a_vncg(t1, t2: TYPE): BOOLEAN is
require
t1.run_type = t1;
t2.run_type = t2;
t2.generic_list /= Void;
eh.empty
local
i: INTEGER;
do
from
i := list.upper;
until
Result or else i = 0
loop
Result := list.item(i).is_a_vncg(t1,t2);
i := i - 1;
end;
ensure
eh.empty
end;
e_feature(fn: FEATURE_NAME): E_FEATURE is
local
i: INTEGER;
do
from
i := list.upper;
until
Result /= Void or else i = 0
loop
Result := list.item(i).e_feature(fn);
i := i - 1;
end;
end;
collect_invariant(rc: RUN_CLASS) is
require
rc /= Void
local
i: INTEGER;
do
from
i := list.upper;
until
i = 0
loop
list.item(i).base_class.collect_invariant(rc);
i := i - 1;
end;
end;
inherit_cycle_check is
local
i: INTEGER;
p: PARENT;
bc: BASE_CLASS;
do
from
i := list.upper;
until
i = 0
loop
p := list.item(i);
bc := p.base_class;
if bc = Void then
eh.add_position(p.start_position);
fatal_error(fz_cnf);
else
bc.inherit_cycle_check;
end;
i := i - 1;
end;
end;
has_parent(c: BASE_CLASS): BOOLEAN is
require
not c.is_any
local
i: INTEGER;
bc: BASE_CLASS;
do
from
i := list.upper;
until
i = 0
loop
bc := list.item(i).base_class;
if c = bc then
Result := true;
i := 0;
elseif bc.is_subclass_of_aux(c) then
Result := true;
i := 0;
else
i := i - 1;
end;
end;
end;
first_parent_for(c: BASE_CLASS): PARENT is
-- Gives the first parent going to `c'.
local
i: INTEGER;
pbc: BASE_CLASS;
do
from
i := 1;
until
Result /= Void
loop
Result := list.item(i);
pbc := Result.base_class;
if pbc = c then
elseif pbc.is_subclass_of(c) then
else
Result := Void;
end;
i := i + 1;
end;
ensure
Result /= Void
end;
next_parent_for(c: BASE_CLASS; previous: PARENT): like previous is
-- Gives the next one or Void.
local
i: INTEGER;
pbc: BASE_CLASS;
do
from
from
i := 1;
until
Result = previous
loop
Result := list.item(i);
i := i + 1;
end;
Result := Void;
until
Result /= Void or else i > list.count
loop
Result := list.item(i);
pbc := Result.base_class;
if pbc = c then
elseif pbc.is_subclass_of(c) then
else
Result := Void;
end;
i := i + 1;
end;
end;
header_comment_for(ci: CLASS_INVARIANT) is
local
i: INTEGER;
do
from
i := list.upper;
until
i = 0 or else ci.header_comment /= Void
loop
list.item(i).base_class.header_comment_for(ci);
i := i - 1;
end;
end;
get_started is
local
i1, i2: INTEGER;
p1, p2: PARENT;
do
from
i1 := list.upper;
until
i1 = 0
loop
list.item(i1).get_started(Current);
i1 := i1 - 1;
end;
if list.upper > 1 then
-- Checking select :
from
i2 := list.upper;
until
i2 = 1
loop
from
i1 := 1;
invariant
i1 < i2 + 1
variant
i2 - i1
until
i1 = i2
loop
p1 := list.item(i1);
p2 := list.item(i2);
p1.multiple_check(p2);
p2.multiple_check(p1);
i1 := i1 + 1;
end;
i2 := i2 - 1;
end;
end;
end;
look_up_for(rc: RUN_CLASS; fn: FEATURE_NAME): E_FEATURE is
local
i: INTEGER;
p1, p2: PARENT;
f1, f2: E_FEATURE;
do
from
i := list.upper;
until
f1 /= Void or else i = 0
loop
p1 := list.item(i);
f1 := p1.look_up_for(rc,fn);
i := i - 1;
end;
from
until
i = 0
loop
p2 := list.item(i);
f2 := p2.look_up_for(rc,fn);
if f2 = Void then
elseif f1 = f2 then
elseif not f2.is_merge_with(f1,rc) then
eh.add_position(start_position);
eh.add_position(f1.start_position);
eh.add_position(f2.start_position);
fatal_error(fz_ich);
elseif f2.is_deferred then
elseif f1.is_deferred then
f1 := f2;
p1 := p2;
elseif p1.has_redefine(fn) then
if p2.has_redefine(fn) then
else
eh.add_position(fn.start_position);
eh.add_position(p2.start_position);
eh.add_position(f2.start_position);
eh.append(em1);
eh.print_as_fatal_error;
end;
elseif p2.has_redefine(fn) then
eh.add_position(fn.start_position);
eh.add_position(p1.start_position);
eh.add_position(f1.start_position);
eh.append(em1);
eh.print_as_fatal_error;
else
eh.add_position(p2.start_position);
eh.add_position(p1.start_position);
eh.add_position(f1.start_position);
eh.add_position(f2.start_position);
eh.append(em1);
eh.print_as_fatal_error;
end;
i := i - 1;
end;
Result := f1;
end;
collect_assertion(fn: FEATURE_NAME) is
require
fn /= Void
local
i: INTEGER;
p1, p2: PARENT;
fn1, fn2: FEATURE_NAME;
do
from
i := list.upper;
until
i = 0
loop
p2 := list.item(i);
fn2 := p2.name_in_parent(fn);
if fn2 /= Void and then p2.has_select_for(fn) then
p1 := p2;
fn1 := fn2;
end;
i := i - 1;
end;
if fn1 /= Void then
p1.base_class.collect_assertion(fn1);
else
from
i := list.upper;
until
i = 0
loop
p1 := list.item(i);
fn1 := p1.name_in_parent(fn);
if fn1 /= Void then
p1.base_class.collect_assertion(fn1);
end;
i := i - 1;
end;
end;
end;
pretty_print is
local
i: INTEGER;
do
fmt.set_indent_level(0);
if fmt.zen_mode then
fmt.indent;
else
fmt.skip(1);
end;
fmt.keyword("inherit");
fmt.set_indent_level(1);
fmt.indent;
if heading_comment /= Void then
heading_comment.pretty_print;
end;
from
i := 1;
until
i > list.upper
loop
list.item(i).pretty_print;
i := i + 1;
end;
end;
smallest_ancestor(type, other: TYPE): TYPE is
require
type.base_class.parent_list = Current;
other.base_class.parent_list /= Void;
type.is_run_type;
other.is_run_type;
local
i: INTEGER;
p: PARENT;
sa: TYPE;
do
from
i := list.upper;
until
i = 0
loop
p := list.item(i);
sa := p.runnable_type(other);
if Result = Void then
Result := sa;
else
Result := sa.smallest_ancestor(Result);
end;
if Result.is_any then
i := 0;
else
i := i - 1;
end;
end;
ensure
Result.is_run_type;
end;
feature {E_PRECURSOR}
precursor_for(p: E_PRECURSOR; wrf: RUN_FEATURE): EFFECTIVE_ROUTINE is
-- Look for the feature for `p' which is written inside `wrf'.
require
p /= Void;
wrf /= Void
local
i: INTEGER;
parent: PARENT;
f2: like precursor_for;
do
from
i := list.upper;
until
Result /= Void or else i = 0
loop
parent := list.item(i);
Result := parent.precursor_for(p,wrf);
i := i - 1;
end;
if Result = Void then
eh.add_position(p.start_position);
fatal_error("Precursor routine not found.");
end;
if run_control.all_check then
from
until
i = 0
loop
parent := list.item(i);
f2 := parent.precursor_for(p,wrf);
if f2 /= Void and then f2 /= Result then
eh.add_position(p.start_position);
eh.add_position(Result.start_position);
eh.add_position(f2.start_position);
fatal_error("Multiple Precursor found (must use %
% { ... } selection.");
end;
i := i - 1;
end;
end;
end;
feature {NONE}
repeated_inheritance(p1: PARENT; fn1, top_fn: FEATURE_NAME): FEATURE_NAME is
require
p1 /= void;
fn1 /= Void;
top_fn /= Void
local
i: INTEGER;
p2: PARENT;
bc1: BASE_CLASS;
do
from
bc1 := p1.base_class;
i := list.upper;
until
i = 0
loop
p2 := list.item(i);
if p1 /= p2 then
if bc1 = p2.base_class then
if p2.do_rename(fn1).to_string = top_fn.to_string then
Result := top_fn;
elseif p1.do_rename(fn1).to_string = top_fn.to_string then
Result := top_fn;
end;
end;
end;
i := i - 1;
end;
if Result = Void then
Result := fn1;
end;
ensure
top_fn /= Void
end;
em1: STRING is "Inheritance clash.";
invariant
base_class /= Void;
list.lower = 1;
not list.empty;
end -- PARENT_LIST