1/*****************************************************************************
    2 * This file is part of the Prolog Development Tool (PDT)
    3 * 
    4 * WWW: http://sewiki.iai.uni-bonn.de/research/pdt/start
    5 * Mail: pdt@lists.iai.uni-bonn.de
    6 * Copyright (C): 2004-2012, CS Dept. III, University of Bonn
    7 * 
    8 * All rights reserved. This program is  made available under the terms
    9 * of the Eclipse Public License v1.0 which accompanies this distribution,
   10 * and is available at http://www.eclipse.org/legal/epl-v10.html
   11 * 
   12 ****************************************************************************/
   13
   14:- module(loading_roots_finder,[find_loading_roots/0]).   15
   16:- ensure_loaded('../parse_util').   17
   18find_loading_roots:-
   19    fileT(FileId,FileName,_),
   20    	not(load_edge(_,FileId,_,_)),
   21    	format('Loading root: ~w~n',[FileName]).
   22    
   23find_standalone_files:-
   24    fileT(FileId,FileName,_),
   25    	not(load_edge(FileId,_,_,_)),
   26    	not(load_edge(_,FileId,_,_)),
   27    	format('Standalone File: ~w~n',[FileName]).
   28    
   29find_loading_leafs:-
   30    fileT(FileId,FileName,_),
   31    	not(load_edge(FileId,_,_,_)),
   32    	format('Loading root: ~w~n',[FileName]).
   33    
   34:- dynamic load_level/2. %load_level(FileId,Level).
   35:- dynamic load_level_ri/2. %load_level_ri(Level,FileId).    
   36:- dynamic loading_cycle/1.   37    	
   38compute_loading_levels:-
   39    remove_old_loading_levels,
   40    assign_level0_to_leaves,
   41    compute_further_levels,
   42    assign_consistent_level_to_cycles.
   43   
   44remove_old_loading_levels:-
   45    retractall(load_level(_,_)),
   46    retractall(load_level_ri(_,_)),
   47    retractall(loading_cycle(_)).
   48    
   49    
   50:- dynamic next_level/1. 
   51
   52assign_level0_to_leaves:-
   53    fileT(FileId,_,_),
   54    	not(load_edge(FileId,_,_,_)),
   55    	assert(load_level(FileId,0)),
   56    	assert(load_level_ri(0,FileId)),
   57    	fail.
   58assign_level0_to_leaves:-
   59	retractall(next_level(_)),
   60	assert(next_level(1)).	 
   61	
   62	  
   63compute_further_levels:-
   64    repeat,
   65    	next_level(CurrentLevel),
   66    	compute_next_loading_level,
   67    not(load_level_ri(CurrentLevel,_)).
   68
   69
   70
   71compute_next_loading_level:-
   72    next_level(CurrentLevel),
   73    format('currentLevel: ~w~n',[CurrentLevel]),
   74    LastLevel is CurrentLevel - 1,
   75    load_level_ri(LastLevel,LoadedFileId),
   76    	load_edge(FileId,LoadedFileId,_,_),
   77    		(	load_level(FileId,_)
   78    		->	(	exists_loading_cycle(LoadedFileId,FileId,[],CircleList)
   79    			->	(	save_loading_cycle(CircleList),
   80    					fail
   81    				)
   82    			;	true	
   83    			)
   84    		;	true
   85    		),
   86    		set_level_to_elem(CurrentLevel,FileId),	
   87    fail.
   88compute_next_loading_level:-
   89    next_level(CurrentLevel),
   90    retractall(next_level(_)),
   91    NextLevel is CurrentLevel + 1,
   92    assert(next_level(NextLevel)).
   93    
   94    
   95exists_loading_cycle(Source,Target,[],[Source,Target]):-
   96    load_edge(Source,Target,_,_),!.
   97exists_loading_cycle(Source,Target,List,CompleteCycleList):-  
   98	load_edge(Source,Help,_,_),  
   99    exists_loading_cycle(Help,Target,[Source|List],CompleteCycleList).
  100    
  101    
  102:- dynamic loading_cycle/1.  103save_loading_cycle(Cycle):-
  104    not(existing_cycle(Cycle)),
  105    assert(loading_cycle(Cycle)).
  106    
  107existing_cycle([First,Second|_]):-		
  108    loading_cycle(ExistingCycle),
  109    	member(First,ExistingCycle),
  110    	member(Second,ExistingCycle).
  111    	
  112assign_consistent_level_to_cycles:-
  113    loading_cycle(Cycle),
  114    	get_cycle_levels(Cycle,0,Max),
  115    	set_members_to(Cycle,Max),
  116    fail.
  117assign_consistent_level_to_cycles. 
  118
  119get_cycle_levels([],Max,Max).
  120get_cycle_levels([Head|Tail],OldMax,Max):-
  121	load_level(Head,Current),
  122	CurrentMax is max(Current,OldMax),
  123	get_cycle_levels(Tail,CurrentMax,Max).
  124	
  125set_members_to(Cycle,Max):-
  126    forall(member(Elem,Cycle),
  127    	set_level_to_elem(Max,Elem)).
  128	    
  129set_level_to_elem(Level,Elem):-
  130    ground(Elem),
  131    retractall(load_level(Elem,_)),	
  132    retractall(load_level(_,Elem)),
  133    assert(load_level(Elem,Level)),
  134    assert(load_level_ri(Level,Elem))