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(load_graph,[build_new_load_graph/0, build_load_graph/0]). 15:- ensure_loaded(parse_util). 16:- use_module(library(lists)). 17 18 19/* 20 * build_new_load_graph/0 21 * retracts all load_edge/3 of a former load-graph and 22 * builds a new one with respect to all given 23 * load_dir/4 using build_load_graph/0. 24 */ 25build_new_load_graph:- 26 retractall(load_edge(_,_,_)), 27 retractall(warning(_,'file not found in project',_)), 28 retractall(warning(_,'guessed file reference',_)), 29 retractall(warning(_,'link to external library',_)), 30 build_load_graph. 31 32/* 33* build_load_graph/0 34* tries to build the corresponding load_edge/3 for each load_dir/4 it 35* can find. 36* If it cannot find the correct file that is loaded with the considered 37* directive it tries to guess the file: It compares the file name with each 38* file name it can find. 39* Only files that are parsed with the preparser are considered. If no such 40* file can be found a warning will be created, if it is not a reference 41* to a library file. 42* (Libraries will not be in the working context in most cases.) 43* 44* Finishes with retracting all load_dir/4. 45**/ 46 47/* ToDo: inform the user about the guessing? 48 use the given path for the guesseing? -> concat 49 */ 50build_load_graph:- 51 load_dir(Directive,ToLoadFiles,Imports), 52 flatten(ToLoadFiles,ToLoadFilesFlatt), 53 build_load_edges_for_list(ToLoadFilesFlatt,Imports,Directive), 54 fail. 55build_load_graph. 56%build_load_graph:- 57% retractall(load_dir(_,_,_,_)). 58 59/* 60 * build_load_edges_for_list(+ArgList,+LoadingFileId,+LoadingDirectiveId) 61 * builds the load edges for all Arguments inside of ArgList with the 62 * help of build_complex_load_edges/3. 63 **/ 64build_load_edges_for_list([File],Imports,Directive):- 65 !, 66 directiveT(Directive,LoadingId,_), 67 lookup_complex_file_reference(File,LoadingId,FileId,Warning), 68 ( FileId = '' 69 -> true 70 ; assert(load_edge(LoadingId,FileId,Imports,Directive)) 71 ), 72 ( Warning = '' 73 -> true 74 ; assert(warning(Directive,Warning,File)) 75 ). 76build_load_edges_for_list([A|B],LoadingId,Imports,Directive):- 77 build_load_edges_for_list([A],LoadingId,Imports,Directive), 78 build_load_edges_for_list(B,LoadingId,Imports,Directive). 79 80 81 82lookup_complex_file_reference(Arg,LoadingId,FileId,''):- 83 atom(Arg), 84 !, 85 lookup_direct_file_reference(Arg,LoadingId,FileId). 86lookup_complex_file_reference(ToLoadConstruct,LoadingId,FileId,''):- 87 ToLoadConstruct =.. [PathKey,File], 88 compute_dir_with_file_search_path(PathKey,FlatDir), 89 combine_two_path_elements(FlatDir,File,FileName), 90 lookup_direct_file_reference(FileName,LoadingId,FileId), 91 !. 92lookup_complex_file_reference(ToLoadConstruct,_LoadingId,FileId,'guessed file reference'):- 93 ToLoadConstruct =.. [_,FilePath], 94 get_path_with_prolog_file_ending(FilePath,FilePathPl), 95 fileT_ri(AFile,FileId), %ToDo: optimierbar? 96 atom_concat(_,FilePathPl,AFile), 97 !. 98lookup_complex_file_reference(library(_Name),_LoadingId,'','link to external library'):- 99 % if it is a reference to a library file 100 % the library may not be inside the project we parse 101 % so there may be no fileT for it to find with build_direct_load_edge 102 !. 103lookup_complex_file_reference(_Args,_LoadingId,'','file not found in project'). 104 105 106 107 108lookup_direct_file_reference(ToLoad,LoadingId,Id):- 109 prolog_file_type(Pl,prolog), 110 fileT(LoadingId,LoadingName,_), 111 absolute_file_name(ToLoad,[extensions(Pl),relative_to(LoadingName)],FileName), 112 find_file_id_for_file_name(FileName,Id), 113 !. 114 115 116/* 117 * find_file_id_for_file_name(?FileName, ?Id) is_det 118 * 119 * This predicate can be used if one get's a file name via absolute_file_name/3. 120 * absolute_file_name/3 generates lower case names even if the reference file 121 * name (the name of the file to which you compare the relative file name) is given 122 * as with an upper case absolute path. 123 * 124 * Either Arg2 is the id of a fileT fact with arg1 as respective file name, or 125 * id is the id of a fileT that has a file name that is equal to arg2 after 126 * converting all letters to lower case (for both names). 127 * 128 * (alternatively one could store names in fielT_ri as lower case, would be much faster) 129 */ 130find_file_id_for_file_name(FileName,Id):- 131 fileT_ri(FileName,Id). 132find_file_id_for_file_name(FileName,Id):- 133 downcase_atom(FileName,LowerFileName), 134 fileT_ri(AFileName,Id), 135 downcase_atom(AFileName,LowerAFileName), 136 LowerFileName == LowerAFileName. 137 138/* 139 * compute_dir_with_file_search_path(+Key, -FinalDir) 140 * resolves the directory represented by Arg1 141 * with file_search_path/2. 142 * 143 * It does this recursivley, if the path given by 144 * file_search_path is not a plain path but a refernce 145 * with a key to another path stored in file_search_path/2. 146 **/ 147compute_dir_with_file_search_path(Key,FinalDir):- 148 file_search_path(Key,Dir), 149 ( Dir =.. [InnerKey,DirPath] 150 -> compute_dir_with_file_search_path(InnerKey,InnerDir), 151 combine_two_path_elements(InnerDir,DirPath,FinalDir) 152 ; Dir = FinalDir 153 ). 154 155 156get_path_with_prolog_file_ending(FilePath,FilePathPl):- 157 path_to_list(FilePath,List), 158 last(List,File), 159 append(PrePath,File,List), 160 prolog_file_type(Pl,prolog), 161 file_name_extension(File,Pl,FilePl), 162 append(PrePath,FilePl,ListPl), 163 atomic_list_concat(ListPl,'/',FilePathPl). 164 165/* 166 * combine_tow_path_elements(+First,+Second,-Combination,+Directive) 167 * Arg3 is the atom that begins with Arg1, is followed 168 * with a '/' and ends with Arg2. If Arg1 and Arg2 are 169 * terms their atom representation is used. 170 * 171 * Arg4 is needed to compose some warnings if it stumbles 172 * over syntax errors. 173 **/ 174/* combine_two_path_elements(First,Second,Combination,Directive):- 175 ( not(atomic(First)), assert(warning(Directive,'is not atomic',[First])), writeln('first not atomic') 176 ; not(atomic(Second)), 177 assert(warning(Directive,'is not atomic',[Second])), 178 writeln('second not atomic'), 179 path_to_list(Second,Atomic_Second) 180 ; atomic(First), atomic(Second), writeln('both atomic'), 181 atomic_list_concat([First,'/',Second],Combination) 182 ).*/ 183 184 185/* 186 * combine_tow_path_elements(+First,+Second,-Combination) 187 * Arg3 is the atom that begins with Arg1, is followed 188 * with a '/' and ends with Arg2. If Arg1 and Arg2 are 189 * terms their atom representation is used. 190 **/ 191combine_two_path_elements(First,Second,Combination):- 192 listify_path_element(First,FirstList), 193 listify_path_element(Second,SecondList), 194 append(FirstList,SecondList,List), 195 atomic_list_concat(List,'/',Combination). 196 197listify_path_element(Elem,List):- 198 ( atomic(Elem) 199 -> List = [Elem] 200 ; path_to_list(Elem,List) 201 ). 202 203/* 204 * path_to_list(+Path,?List) 205 * This is more or less the reversion of atomic_list_concat/3 206 * with '/' as seperator. 207 * Arg1 ia a term that should describe at least a part of a file path 208 * Arg2 is a list of all parts of the term, that are seperated by '/'. 209 **/ 210path_to_list(Path,List):- 211 Path =.. [/,First,Second], 212 listify_path_element(First,FirstList), 213 listify_path_element(Second,SecondList), 214 append(FirstList,SecondList,List)