/src/tools/semantics/liberty_cluster.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_CLUSTER
 16   --
 17   -- Clustering rules:
 18   -- A given directory is a cluster if:
 19   --
 20   -- 1. It contains a cluster.rc file.
 21   -- In that case, that file describes the cluster, giving it a name, a version number, dependencies and
 22   -- default options (assertion level, debug...)
 23   -- If the directory also contains a loadpath.se file then that file is used to describe which directories
 24   -- are part of the cluster itself (see below).
 25   --
 26   -- 2. It contains a loadpath.se file.
 27   -- Each line of the loadpath is a path to either a cluster.rc file, a loadpath.se file, or a directory. In
 28   -- the latter case, the clustering rules apply. If the given directory contains neither a cluster.rc nor a
 29   -- loadpath.se file, the directory is considered to belong to the cluster.
 30   --
 31
 32insert
 33   HASHABLE
 34   LOGGING
 35      undefine
 36         is_equal
 37      end
 38
 39create {LIBERTY_UNIVERSE}
 40   make_root
 41
 42create {LIBERTY_CLUSTER}
 43   make_from_loadpath, make_from_etc
 44
 45create {LIBERTY_CLASS_DESCRIPTOR}
 46   make_void
 47
 48feature {ANY}
 49   name: FIXED_STRING
 50   locations: TRAVERSABLE[FIXED_STRING]
 51   depth: INTEGER
 52
 53feature {ANY}
 54   hash_code: INTEGER
 55
 56   is_equal (other: like Current): BOOLEAN is
 57      do
 58         Result := other.locations.is_equal(locations)
 59      end
 60
 61   location_of (a_class_name: FIXED_STRING): FIXED_STRING is
 62      do
 63         Result := class_names.fast_reference_at(a_class_name)
 64         -- if Result = Void then
 65         --    Result := find(a_class_name).location_of(a_class_name)
 66         -- end
 67      end
 68
 69   has_parent (a_cluster: LIBERTY_CLUSTER): BOOLEAN is
 70      do
 71         Result := a_cluster = Current or else (Current /= root and then parent.has_parent(a_cluster))
 72      end
 73
 74feature {LIBERTY_UNIVERSE, LIBERTY_TYPE_RESOLVER}
 75   find (a_class_name: FIXED_STRING): LIBERTY_CLUSTER is
 76      local
 77         filename: STRING
 78         new_mark: like find_mark
 79      do
 80         filename := once ""
 81         filename.make_from_string(a_class_name)
 82         filename.to_lower
 83         filename.append(once ".e")
 84         find_mark_counter.increment
 85         new_mark := find_mark_counter.value
 86         Result := find_cluster(a_class_name, filename, new_mark)
 87         if Result = Void and then root /= Current then
 88            Result := root.find_cluster(a_class_name, filename, new_mark)
 89         end
 90      ensure
 91         Result /= Void implies Result.location_of(a_class_name) /= Void
 92      end
 93
 94feature {LIBERTY_CLUSTER}
 95   find_cluster (a_class_name: FIXED_STRING; a_file_name: STRING; new_mark: like find_mark): LIBERTY_CLUSTER is
 96      local
 97         i: INTEGER
 98      do
 99         if find_mark < new_mark then
100            find_mark := new_mark
101            from
102               i := locations.lower
103            until
104               Result /= Void or else i > locations.upper
105            loop
106               if find_here(locations.item(i), a_file_name) then
107                  class_names.put(locations.item(i), a_class_name)
108                  Result := Current
109               end
110               i := i + 1
111            end
112            if Result = Void then
113               Result := find_child(a_class_name, a_file_name, new_mark)
114            end
115         end
116      end
117
118   log_cluster_tree (tab: INTEGER) is
119      require
120         tab >= 0
121      local
122         info: OUTPUT_STREAM; i: INTEGER
123      do
124         info := log.info
125         from
126            i := 0
127         until
128            i = tab
129         loop
130            info.put_string(once " |  ")
131            i := i + 1
132         end
133         info.put_string(once " +- (")
134         info.put_integer(depth)
135         info.put_string(once ") ")
136         if logged then
137            info.put_string(name)
138            info.put_line(once " ...")
139         else
140            info.put_line(name)
141            children.do_all(agent {LIBERTY_CLUSTER}.log_cluster_tree(tab + 1))
142            logged := True
143         end
144      ensure
145         logged
146      end
147
148feature {} -- find
149   find_here (a_location: FIXED_STRING; a_file_name: STRING): BOOLEAN is
150      local
151         here: STRING
152      do
153         here := once ""
154         here.make_from_string(a_location)
155         dir.connect_to(here)
156         if dir.is_connected then
157            from
158               dir.read_entry
159            until
160               Result or else dir.end_of_input
161            loop
162               if dir.last_entry.is_equal(a_file_name) then
163                  Result := True
164               end
165               dir.read_entry
166            end
167            dir.disconnect
168         end
169      end
170
171   find_child (a_class_name: FIXED_STRING; a_file_name: STRING; new_mark: like find_mark): LIBERTY_CLUSTER is
172      local
173         child: LIBERTY_CLUSTER
174         i: INTEGER
175      do
176         from
177            i := children.lower
178         until
179            Result /= Void or else i > children.upper
180         loop
181            child := children.item(i)
182            if child.depth >= depth then
183               Result := child.find_cluster(a_class_name, a_file_name, new_mark)
184            end
185            i := i + 1
186         end
187      end
188
189feature {}
190   make_void is
191      do
192         name := "<Void>".intern
193         create class_names.with_capacity(0)
194         create {FAST_ARRAY[FIXED_STRING]} locations.with_capacity(0)
195         depth := -1
196      end
197
198   make_root is
199      local
200         c: FAST_ARRAY[LIBERTY_CLUSTER]
201         etc: LIBERTY_ETC
202      do
203         name := "<Root>".intern
204         create {FAST_ARRAY[FIXED_STRING]} locations.with_capacity(0)
205         create class_names.with_capacity(7)
206         root := Current
207         parent := Current
208         create c.with_capacity(etc.clusters.count)
209         children := c
210         etc.clusters.do_all(agent add_if_root({LIBERTY_ETC_CLUSTER}, c))
211         log_cluster_tree(0)
212      ensure
213         depth = 0
214      end
215
216   add_if_root (a_etc: LIBERTY_ETC_CLUSTER; a_children: FAST_ARRAY[LIBERTY_CLUSTER]) is
217      require
218         is_root: root = Current
219         in_other_words: depth = 0
220      do
221         if a_etc.depth = 0 and then a_etc.cluster = Void then
222            log.trace.put_string(name)
223            log.trace.put_string(once ": adding root cluster from etc ")
224            log.trace.put_line(a_etc.name)
225            a_children.add_last(create {LIBERTY_CLUSTER}.make_from_etc(a_etc, Current, Current))
226         end
227      end
228
229   make_from_etc (a_etc: LIBERTY_ETC_CLUSTER; a_parent: like parent; a_root: like root) is
230      require
231         a_etc /= Void
232         a_root /= Void
233         a_etc.cluster = Void
234         a_root.depth = 0
235         a_parent /= Void
236      local
237         c: FAST_ARRAY[LIBERTY_CLUSTER]
238      do
239         depth := a_parent.depth + 1
240         parent := a_parent
241         name := a_etc.name
242         root := a_root
243         locations := a_etc.locations
244         create class_names.with_capacity(16)
245         create c.with_capacity(a_etc.needs.count)
246         children := c
247         log.info.put_string(once "Cluster (")
248         log.info.put_integer(depth)
249         log.info.put_string(once ") ")
250         log.info.put_string(name)
251         log.info.put_string(once ": ")
252         log.info.put_line(locations.out)
253         a_etc.set_cluster(Current)
254         a_etc.needs.do_all(agent add_needs({LIBERTY_ETC_NEEDS}, c, a_root))
255      ensure
256         root = a_root
257         parent = a_parent
258         depth = a_parent.depth + 1
259         locations = a_etc.locations
260      end
261
262   add_needs (a_etc: LIBERTY_ETC_NEEDS; a_children: FAST_ARRAY[LIBERTY_CLUSTER]; a_root: like root) is
263      require
264         a_root.depth = 0
265      do
266         if a_etc.cluster.cluster /= Void then
267            if not has_parent(a_etc.cluster.cluster) then
268               a_children.add_last(a_etc.cluster.cluster)
269            end
270         else
271            log.trace.put_string(name)
272            log.trace.put_string(once ": adding child cluster from etc ")
273            log.trace.put_line(a_etc.cluster.name)
274            a_children.add_last(create {LIBERTY_CLUSTER}.make_from_etc(a_etc.cluster, Current, root))
275         end
276      end
277
278   make_from_loadpath (a_loadpath: STRING; a_parent: like parent; a_root: like root) is
279      require
280         a_loadpath /= Void
281         a_root.depth = 0
282         a_parent /= Void
283      local
284         location_directory: STRING
285      do
286         log.warning.put_line(once "Effective clusters should not be created directly from classpath.se anymore! (only master clusters should)")
287
288         if not ft.is_file(a_loadpath) then
289            std_error.put_line("*** Error: not a loadpath: " + a_loadpath)
290            die_with_code(1)
291         end
292
293         depth := a_parent.depth + 1
294         parent := a_parent
295         root := a_root
296         name := a_loadpath.intern
297         dir.compute_parent_directory_of(a_loadpath)
298         if dir.last_entry.is_empty then
299            location_directory := dir.current_working_directory.out
300         else
301            location_directory := dir.last_entry.twin
302         end
303         create class_names.with_capacity(16)
304         log.info.put_string(once "Cluster (")
305         log.info.put_integer(depth)
306         log.info.put_string(once ") ")
307         log.info.put_string(name)
308         log.info.put_string(once ": ")
309         log.info.put_line(locations.out)
310         read_loadpath(a_loadpath, location_directory)
311      ensure
312         root = a_root
313         depth = a_parent.depth + 1
314         parent = a_parent
315      end
316
317   read_loadpath (a_loadpath, a_location_directory: STRING) is
318      require
319         root /= Void
320         ft.is_file(a_loadpath)
321      local
322         loc: FAST_ARRAY[FIXED_STRING]
323         c: FAST_ARRAY[LIBERTY_CLUSTER]
324      do
325         create loc.with_capacity(4)
326         create c.with_capacity(2)
327         tfr.connect_to(a_loadpath)
328         if tfr.is_connected then
329            from
330               tfr.read_line
331            until
332               tfr.end_of_input
333            loop
334               env.substitute(tfr.last_string)
335               process_loadpath(loc, c, a_location_directory, tfr.last_string)
336               tfr.read_line
337            end
338            env.substitute(tfr.last_string)
339            process_loadpath(loc, c, a_location_directory, tfr.last_string)
340            tfr.disconnect
341         end
342         locations := loc
343         children := c
344      end
345
346   process_loadpath (a_locations: FAST_ARRAY[FIXED_STRING]; a_children: FAST_ARRAY[LIBERTY_CLUSTER]; a_location_directory, loadpath_line: STRING) is
347      require
348         a_locations /= Void
349         a_children /= Void
350         loadpath_line /= Void
351         root /= Void
352      local
353         sublocation: STRING
354      do
355         if not loadpath_line.is_empty and then not loadpath_line.has_prefix(once "--") then
356            sublocation := ""
357            dir.ensure_system_notation
358            dir.system_notation.from_notation(loadpath_notation, loadpath_line)
359
360            if dir.system_notation.is_absolute_path(loadpath_line) then
361               sublocation.copy(loadpath_line)
362            else
363               dir.compute_subdirectory_with(a_location_directory, loadpath_line)
364               if dir.last_entry.is_empty then
365                  --| *** TODO error: the loadpath line does not contain a valid path
366                  not_yet_implemented
367               end
368               sublocation.copy(dir.last_entry)
369            end
370            if ft.is_directory(sublocation) then
371               a_locations.add_last(sublocation.intern)
372            elseif ft.is_file(sublocation) then
373               log.trace.put_string(name)
374               log.trace.put_string(once ": adding child cluster from loadpath ")
375               log.trace.put_line(sublocation)
376               a_children.add_last(create {LIBERTY_CLUSTER}.make_from_loadpath(sublocation, Current, root));
377            else
378               std_error.put_line(once "*** Warning: ignored location: " + sublocation)
379            end
380         end
381      end
382
383   dir: BASIC_DIRECTORY
384
385   tfr: TEXT_FILE_READ is
386      once
387         create Result.make
388      end
389
390   ft: FILE_TOOLS
391
392   children: TRAVERSABLE[LIBERTY_CLUSTER]
393   class_names: HASHED_DICTIONARY[FIXED_STRING, FIXED_STRING]
394   root: LIBERTY_CLUSTER
395   parent: LIBERTY_CLUSTER
396
397   loadpath_entry: POSIX_PATH_NAME is
398      once
399         create Result.make_empty
400      end
401
402   loadpath_notation: UNIX_DIRECTORY_NOTATION is
403      once
404         create Result
405      end
406
407   env: LIBERTY_ENVIRONMENT
408   find_mark: INTEGER
409   logged: BOOLEAN
410
411   find_mark_counter: COUNTER is
412      once
413         create Result
414      end
415
416invariant
417   not name.is_empty
418   class_names /= Void
419   locations.for_all(agent ft.is_directory)
420   root.depth = 0
421   depth = 0 implies root = Current
422   parent /= Void
423   Current = root implies Current = parent
424   depth >= 0
425
426end