note description: "Topological sort on classes." legal: "See notice at end of class." status: "See notice at end of class." date: "$Date$" revision: "$Revision$" class CLASS_SORTER inherit COMPILER_EXPORTER SHARED_ERROR_HANDLER export {NONE} all end SHARED_COUNTER export {NONE} all end SHARED_CONFIGURE_RESOURCES export {NONE} all end create make feature {NONE} -- Initialization make -- Creation do create order.make_empty create precursor_count.make_empty create successors.make_empty create original.make_empty create outsides1.make (1) create outsides2.make end init (n: INTEGER) -- Initialization for `n' items to sort. require n_positive: n > 0 local c: CLASS_C do across system.classes as ic until attached c loop c := ic.item end order.conservative_resize_with_default (c, 1, n) precursor_count.conservative_resize_with_default (0, 1, n) successors.conservative_resize_with_default (create {like successors.item}.make (0), 1, n) original.conservative_resize_with_default (c, 1, n) outsides1.wipe_out outsides2.wipe_out count := n clear fill_original ensure count_set: count = n order_capacity_set: order.capacity >= n successors_capacity_set: successors.capacity >= n original_capacity_set: original.capacity >= n outsides1_empty: outsides1.is_empty outsides2_empty: outsides2.is_empty end feature -- Sort sort -- Topological sort of classes local n: like system.classes.count do -- Initialize data structures n := system.classes.count if n > 0 then init (n) -- Initialize arrays `successors' and `precursor_count'. fill -- Perform sort perform_sort -- Check validity: there must be no cycle in the -- inheritance graph check_validity end end feature {NONE} -- Access count: INTEGER -- Number of items to sort order: ARRAY [CLASS_C] -- Order to build original: ARRAY [CLASS_C] -- Origin order (unsorted) precursor_count: ARRAY [INTEGER] -- Count of precursors outsides1: ARRAYED_LIST [CLASS_C] outsides2: PART_SORTED_TWO_WAY_LIST [CLASS_C] -- Items with precursor count equal to 0 successors: ARRAY [ARRAYED_LIST [CLASS_C]] -- Succesors of items feature {NONE} -- Filling fill_original -- Fill `original' with the lists `descendants' of classes local class_array: ARRAY [CLASS_C] i, nb: INTEGER a_class: CLASS_C do class_array := System.classes check consistency: count = System.classes.count end count := 0 from nb := Class_counter.count i := 1 until i > nb loop a_class := class_array.item (i) if a_class /= Void then count := count + 1 a_class.set_topological_id (count) original.put (a_class, count) successors.put (a_class.direct_descendants, count) end i := i + 1 end end fill -- Fill `precursor_count' and `outsides'. require good_context: count > 0 local i, k, succ_id: INTEGER succ: ARRAYED_LIST [CLASS_C] do from -- Initialization of `precursor_count' i := 1 until i > count loop from succ := successors.item (i) check successor_exists: succ /= Void -- Data structure `successors' for id `i' -- must exist. end succ.start until succ.after loop succ_id := succ.item.topological_id k := precursor_count.item (succ_id) precursor_count.put (k + 1, succ_id) succ.forth end i := i + 1 end from -- Initialization of `outsides' i := 1 until i > count loop if precursor_count.item (i) = 0 then outsides1.extend (original.item (i)) outsides2.extend (original.item (i)) end i := i + 1 end end perform_sort -- Perform topological sort require good_context: count > 0 local next, k, succ_id: INTEGER item, succ_item: CLASS_C succ: ARRAYED_LIST [CLASS_C] do if Configure_resources.get_boolean ("topo", True) then insert_succ (successors.item (outsides1.first.topological_id)) from outsides1.start until outsides1.after loop next := next + 1 order.put (outsides1.item, next) outsides1.forth end else from until outsides2.is_empty loop item := outsides2.first outsides2.start outsides2.remove next := next + 1 order.put (item, next) from succ := successors.item (item.topological_id) succ.start until succ.after loop succ_item := succ.item succ_id := succ_item.topological_id k := precursor_count.item (succ_id) if k = 0 then -- Nothing elseif k = 1 then outsides2.extend (succ_item) precursor_count.put (0, succ_id) else precursor_count.put (k - 1, succ_id) end succ.forth end end end end insert_succ (succ_list: ARRAYED_LIST [CLASS_C]) -- Insert all the successors in `outsides' if they don't have any -- precursor which still remains for a later sutdy. require succ_list_not_void: succ_list /= Void local succ: ARRAY [CLASS_C] i, nb_item, succ_id, k: INTEGER succ_item: CLASS_C do succ := sort_succ (succ_list) if succ /= Void then from nb_item := succ_list.count i := 1 until i > nb_item loop succ_item := succ.item (i) succ_id := succ_item.topological_id k := precursor_count.item (succ_id) if k = 0 then -- Nothing elseif k = 1 then outsides1.extend (succ_item) precursor_count.put (0, succ_id) insert_succ (successors.item (succ_id)) else precursor_count.put (k - 1, succ_id) end i := i + 1 end end end sort_succ (succ: ARRAYED_LIST [CLASS_C]): ARRAY [CLASS_C] -- Create a sorted array of CLASS_C where the criteria is -- less precursor and less successors and more class usage (i.e. -- referring more classes). require succ_not_void: succ /= Void local a_class: CLASS_C i, j, nb_succ, nb_prec, nb_item, nb_clients: INTEGER class_id: INTEGER inserted: BOOLEAN index: ARRAY [INTEGER] do nb_item := succ.count if succ.count /= 0 then from create Result.make_filled (succ [1], 1, nb_item) create index.make_filled (0, 1, nb_item) nb_item := 0 succ.start until succ.after loop a_class := succ.item class_id := a_class.topological_id nb_succ := successors.item (class_id).count nb_prec := precursor_count.item (class_id) nb_clients := a_class.syntactical_suppliers.count from inserted := False i := 1 until inserted or else i > nb_item loop if nb_prec < index.item (i) or else (nb_prec = index.item (i) and then nb_succ <= successors.item (Result.item (i).topological_id).count) then inserted := True nb_item := nb_item + 1 from j := nb_item until j = i loop Result.put (Result.item (j - 1), j) index.put (index.item (j - 1), j) j := j - 1 end Result.put (a_class, j) index.put (nb_prec, j) else i := i + 1 end end if not inserted then nb_item := nb_item + 1 Result.put (a_class, nb_item) index.put (nb_prec, nb_item) end succ.forth end end end check_validity -- Check if there is cycle(s) in the inheritance graph local i, l_count: INTEGER name_list: LINKED_LIST [INTEGER] vhpr1: VHPR1 l_precursor_count: like precursor_count l_cyclic_inheritance_list: LINKED_LIST [CLASS_C] l_exit, l_remove: BOOLEAN l_direct_descendants: ARRAYED_LIST [CLASS_C] do from l_precursor_count := precursor_count create l_cyclic_inheritance_list.make i := 1 l_count := count until i > l_count loop if l_precursor_count [i] /= 0 then -- I_th item of the graph is involved in a cycle -- in the inheritance graph l_cyclic_inheritance_list.put_front (original [i]) end i := i + 1 end if l_cyclic_inheritance_list.is_empty then -- Update class ids finalize else -- Cycle(s) in inheritance graph -- List needs post-processing to remove false positives of descendents of classes involved -- in the cyclic inheritance loop. create vhpr1 create name_list.make from l_exit := False until l_exit loop from l_exit := True l_cyclic_inheritance_list.start until l_cyclic_inheritance_list.after loop l_direct_descendants := l_cyclic_inheritance_list.item.direct_descendants from l_direct_descendants.start l_remove := True until l_direct_descendants.after loop if l_cyclic_inheritance_list.has (l_direct_descendants.item) then l_remove := False end l_direct_descendants.forth end if l_remove then l_exit := False l_cyclic_inheritance_list.remove else l_cyclic_inheritance_list.forth end end end from l_cyclic_inheritance_list.start until l_cyclic_inheritance_list.after loop name_list.extend (l_cyclic_inheritance_list.item.class_id) l_cyclic_inheritance_list.forth end vhpr1.set_involved_classes (name_list) Error_handler.insert_error (vhpr1) end end finalize -- Finalization of the topological sort: i.e change the -- class ids local i: INTEGER cl: CLASS_C do from i := 1 until i > count loop cl := order.item (i) debug ("ACTIVITY", "DLE TOPO") io.error.put_integer (i) io.error.put_string (": ") io.error.put_string (cl.name) io.error.put_new_line end cl.set_topological_id (i) i := i + 1 end System.set_max_class_id (count) -- update_system end feature -- Update System update_system -- Sort all the data structures of the system by following the new -- topological sort local nb: INTEGER do order := System.classes nb := class_counter.count sort_class_c (nb) end feature -- Wipe out clear -- Clear the structure do order.clear_all precursor_count.clear_all successors.clear_all original.clear_all outsides1.wipe_out outsides2.wipe_out end feature {NONE} -- Implementation sort_class_c (nb: INTEGER) -- Sort an ARRAY by the topological ID of CLASS_C. do quick_sort (1, nb) end quick_sort (min, max: INTEGER) -- Apply `quick_sort' algorithm. -- If `max' < `min' then it stops local pivo_index: INTEGER do if min < max then pivo_index := partition_quick_sort (min, max) quick_sort (min, pivo_index - 1) quick_sort (pivo_index + 1, max) end end partition_quick_sort (min, max: INTEGER): INTEGER -- Apply `quick_sort' algorithm to position [`min'..`max'] require correct_bounds: min <= max local up, down: INTEGER x, temp: CLASS_C do -- Define the pivot value as the first element of table x := order.item (min) -- Initialize UP to first up := min -- Initialize DOWN to last down := max from until up >= down -- Repeat until up meets or passes down loop -- Increment up until up selects the first element -- greater than the pivot value from until up >= max or else order.item (up) > x loop up := up + 1 end -- Decrement down until it selects the first element -- lesser than or equal to the pivot from until order.item (down) <= x loop down := down - 1 end if up < down then -- If up < down exchange their values until up -- meets or passes down temp := order.item (up) order.put (order.item (down), up) order.put (temp, down) end end temp := order.item (down) order.put (order.item (min), down) order.put (temp, min) Result := down end invariant order_not_void: order /= Void precursor_count_not_void: precursor_count /= Void successors_not_void: successors /= Void original_not_void: original /= Void outsides1_not_void: outsides1 /= Void outsides2_not_void: outsides2 /= Void note copyright: "Copyright (c) 1984-2020, Eiffel Software" license: "GPL version 2 (see http://www.eiffel.com/licensing/gpl.txt)" licensing_options: "http://www.eiffel.com/licensing" copying: "[ This file is part of Eiffel Software's Eiffel Development Environment. Eiffel Software's Eiffel Development Environment 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, version 2 of the License (available at the URL listed under "license" above). Eiffel Software's Eiffel Development Environment 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 Eiffel Software's Eiffel Development Environment; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA ]" source: "[ Eiffel Software 5949 Hollister Ave., Goleta, CA 93117 USA Telephone 805-685-1006, Fax 805-685-6869 Website http://www.eiffel.com Customer support http://support.eiffel.com ]" end