/src/tools/semantics/types/type_builder/liberty_type_parent_loader.e

  1-- This file is part of Liberty Eiffel.
  2--
  3-- Liberty Eiffel is free software: you can redistribute it and/or modify
  4-- it under the terms of the GNU General Public License as published by
  5-- the Free Software Foundation, version 3 of the License.
  6--
  7-- Liberty Eiffel is distributed in the hope that it will be useful,
  8-- but WITHOUT ANY WARRANTY; without even the implied warranty of
  9-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 10-- GNU General Public License for more details.
 11--
 12-- You should have received a copy of the GNU General Public License
 13-- along with Liberty Eiffel.  If not, see <http://www.gnu.org/licenses/>.
 14--
 15class LIBERTY_TYPE_PARENT_LOADER
 16   --
 17   -- Loads the type's parents
 18   --
 19
 20insert
 21   LIBERTY_TYPE_BUILDER_TOOLS
 22   LOGGING
 23
 24creation {LIBERTY_TYPE_BUILDER}
 25   make
 26
 27feature {}
 28   make (a_builder: like builder; a_type: like type; a_universe: like universe; default_effective_generic_parameters: like effective_generic_parameters) is
 29      require
 30         a_builder /= Void
 31         a_type /= Void
 32         a_universe /= Void
 33      do
 34         builder := a_builder
 35         type := a_type
 36         universe := a_universe
 37         effective_generic_parameters := default_effective_generic_parameters
 38      ensure
 39         builder = a_builder
 40         type = a_type
 41         universe = a_universe
 42         effective_generic_parameters = default_effective_generic_parameters
 43      end
 44
 45   universe: LIBERTY_UNIVERSE
 46
 47feature {LIBERTY_TYPE_BUILDER}
 48   load is
 49      local
 50         ast_class: LIBERTY_AST_ONE_CLASS
 51         has_parents: BOOLEAN
 52      do
 53         ast_class := type.ast
 54         if ast_class.obsolete_clause.count > 0 then
 55            errors.add_position(semantics_position_at(ast_class.obsolete_clause.string))
 56            errors.set(level_warning, decoded_string(ast_class.obsolete_clause.string))
 57         end
 58         if is_any then
 59            torch.burn
 60         else
 61            has_parents := add_parents(ast_class.inherit_clause, True, False)
 62            has_parents := add_parents(ast_class.insert_clause, False, has_parents)
 63            check
 64               has_parents
 65            end
 66         end
 67      end
 68
 69feature {}
 70   add_parents (parents: LIBERTY_AST_LIST[LIBERTY_AST_PARENT]; conformant, had_parents: BOOLEAN): BOOLEAN is
 71         -- Returns True if at least a parent was added
 72      local
 73         i: INTEGER; parent_clause: LIBERTY_AST_PARENT
 74         parent: LIBERTY_TYPE; actual_parent: LIBERTY_ACTUAL_TYPE
 75      do
 76         if conformant then
 77            log.trace.put_string(once "Adding conformant parents to ")
 78         else
 79            log.trace.put_string(once "Adding non-conformant parents to ")
 80         end
 81         log.trace.put_line(type.full_name)
 82
 83         from
 84            Result := had_parents
 85            i := parents.list_lower
 86         until
 87            errors.has_error or else i > parents.list_upper
 88         loop
 89            parent_clause := parents.list_item(i)
 90            parent := type_lookup.resolver.type(parent_clause.type_definition)
 91            debug
 92               log.trace.put_string(once "  ")
 93               log.trace.put_string(type.full_name)
 94               if conformant then
 95                  log.trace.put_string(once " --> ")
 96               else
 97                  log.trace.put_string(once " -+> ")
 98               end
 99               log.trace.put_line(parent.full_name)
100            end
101            if parent /= Void then
102               check
103                  parent.is_known
104               end
105               actual_parent ::= parent.known_type
106               type.add_parent(actual_parent, conformant)
107               Result := True
108            end
109            i := i + 1
110         end
111         if not conformant and then not Result and then not errors.has_error then
112            debug
113               log.trace.put_string(type.name)
114               log.trace.put_line(once ": adding default parent ANY")
115            end
116            type.add_parent(universe.type_any, False)
117            Result := True
118         end
119      end
120
121end -- class LIBERTY_TYPE_PARENT_LOADER