View source with raw comments or as raw
    1/*  Part of ClioPatria SeRQL and SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2010, University of Amsterdam,
    7		   VU University Amsterdam
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29*/
   30
   31:- module(cpack_dependency,
   32	  [ file_used_by_file_in_package/3, % +File, -UsedBy, -Package
   33	    cpack_requires/3,		% +Package, -Package, -Why
   34	    cpack_conflicts/3,		% +Package, -Package, -Why
   35	    cpack_list/2,		% +Package, -ListOfImplied
   36	    cpack_list/3,		% +Package, -ListOfImplied, -Dependencies
   37	    cpack_not_satisfied/2,	% +Package, -Reasons
   38	    file_not_satisfied/2,	% +File, -Reasons
   39	    file_imports_from/3,	% +File, -Imports, -From
   40	    file_calls_public_from/3	% +File, -UsedFile, +PI
   41	  ]).   42:- use_module(library(assoc)).   43:- use_module(library(ugraphs)).   44:- use_module(library(semweb/rdf_db)).   45:- use_module(library(semweb/rdfs)).   46:- use_module(repository).

Query the CPACK dependency graph

This module queries the RDF graph produced by xref.pl to compute high-level dependencies between objects. Currently, we keep track of:

To be done
- Extend reasoning */
 file_used_by_file_in_package(+File, -UsedBy, -Package) is nondet
True when UsedBy is a file in Package that imports File.
   68file_used_by_file_in_package(File, UsedBy, Pack) :-
   69	rdf_has(File, cpack:resolves, FileRef),
   70	rdf_has(UsedBy, cpack:usesFile, FileRef),
   71	rdf_has(UsedBy, cpack:inPack, Pack).
 cpack_requires(+Package, -Required, -Reasons) is nondet
True when Package requires Required. Reasons is an ordered set of reasons. Individual reasons are one of:
token(Name)
Package requires token that is provided by Required.
file_ref(FileRef)
Package uses the file FileRef, which is provided by Required
   84cpack_requires(Package, Required, AllReasons) :-
   85	setof(Why, cpack_requires_by(Package, Required, Why), AllReasons).
   86
   87cpack_requires_by(Package, Required, token(Token)) :-
   88	rdf_has(Package, cpack:requires, Req),
   89	(   rdf_is_literal(Req)
   90	->  Token = Req
   91	;   rdf_has(Req, cpack:name, Token)
   92	),
   93	rdf_has(Required, cpack:provides, Token).
   94
   95cpack_requires_by(Package, Required, file_ref(FileRef)) :-
   96	rdf_has(File, cpack:inPack, Package),
   97	rdf_has(File, cpack:usesFile, FileRef),
   98	rdf_has(ReqFile, cpack:resolves, FileRef),
   99	rdf_has(ReqFile, cpack:inPack, Required),
  100	Required \== Package.
 cpack_conflicts(+Package, -Conflict, -Why) is nondet
True when Package and Conflict are in conflict. Defined conflicts are:
same_module(Module, File1, File2)
Both files define the same module. They cannot be loaded into the same Prolog instance. Note that this can cause a package to conflict with itself!
same_file(Path, File1, File2)
Two packages define files at the same path. This is actually not an issue in itself. It only becomes an issue if there are file_ref objects that resolve them ambiguously.
  116cpack_conflicts(Package, Conflict, AllReasons) :-
  117	setof(Why, cpack_conflicts_by(Package, Conflict, Why), AllReasons).
  118
  119cpack_conflicts_by(Package, Conflict, same_module(M,File1,File2)) :-
  120	rdf_has(File1, cpack:module, Module),
  121	rdf_has(File2, cpack:module, Module),
  122	File1 \== File2,
  123	Module = literal(M),
  124	rdf_has(Package, cpack:in_file, File1),
  125	rdf_has(Conflict, cpack:in_file, File2).
  126cpack_conflicts_by(Package, Conflict, same_file(Path,File1,File2)) :-
  127	rdf_has(File1, cpack:path, LPath),
  128	rdf_has(File2, cpack:path, LPath),
  129	File1 \== File2,
  130	LPath = literal(Path),
  131	rdf_has(Package, cpack:in_file, File1),
  132	rdf_has(Conflict, cpack:in_file, File2).
  133
  134
  135		 /*******************************
  136		 *	      GRAPH		*
  137		 *******************************/
 cpack_list(+Pack, -PackList) is det
 cpack_list(+Pack, -PackList, -UGraph) is det
PackList is a list of all packages that need to be installed to get Pack working. This list is ensured to contain Pack.
Arguments:
Pack- is either the URI of a single Pack or a list of these.
UGraph- is a ugraph of Pack-ListOfRequired. See library(ugraph) for details.
To be done
- Toplogical sorting may not be possible. As ordering is not always necessary, we should try to relax dependencies if a topological sort is not possible due to cycles. There are two heuristics here. First of all, explicit (token) dependencies may be removed and second, libraries must be loaded before applications.
  157cpack_list(Pack, Packs) :-
  158	cpack_list(Pack, Packs, _).
  159
  160cpack_list(Pack, Packs, Ugraph) :-
  161	dependency_ugraph(Pack, Ugraph),
  162	(   sort_dependencies(Ugraph, Packs)
  163	->  check_conflicts(Packs)
  164%	    check_satisfied(Packs)
  165	;   domain_error(non_cyclic_dependency_structure, Ugraph)
  166	).
  167
  168check_conflicts(Packs) :-
  169	append(_,[P1|Rest], Packs),
  170	cpack_conflicts(P1, Conflict, Reasons),
  171	member(Conflict, Rest), !,
  172	throw(error(cpack_error(conflict(P1, Conflict, Reasons)), _)).
  173check_conflicts(_).
  174
  175check_satisfied(Packs) :-
  176	maplist(cpack_satisfied, Packs).
  177
  178cpack_satisfied(Pack) :-
  179	cpack_not_satisfied(Pack, Reasons), !,
  180	throw(error(cpack_error(not_satisfied(Pack, Reasons)), _)).
  181cpack_satisfied(_).
 dependency_ugraph(+Pack, -Ugraph) is det
Create a full dependency graph for pack as a ugraph.
  187dependency_ugraph(Pack, UGraph) :-
  188	(   is_list(Pack)
  189	->  Agenda = Pack
  190	;   Agenda = [Pack]
  191	),
  192	empty_assoc(Visited),
  193	dependency_ugraph(Agenda, Visited, Graph),
  194	keysort(Graph, UGraph).
  195
  196dependency_ugraph([], _, []).
  197dependency_ugraph([H|T], Visited, Graph) :-
  198	(   get_assoc(H, Visited, _)
  199	->  dependency_ugraph(T, Visited, Graph)
  200	;   findall(Required, cpack_requires(H, Required, _), RList0),
  201	    sort(RList0, RList),
  202	    Graph = [H-RList|More],
  203	    put_assoc(H, Visited, true, Visited2),
  204	    append(RList, T, Agenda),
  205	    dependency_ugraph(Agenda, Visited2, More)
  206	).
 sort_dependencies(+Graph, -List)
List is a package list that satisfies the dependencies in Graph.
  212sort_dependencies(Graph, List) :-
  213	top_sort(Graph, RList), !,
  214	reverse(RList, List).
  215sort_dependencies(Graph, List) :-
  216	connect_graph(Graph, Start, Connected),
  217	top_sort(Connected, [Start|RList]), !,
  218	reverse(RList, List).
 connect_graph(+Graph, -Start, -Connected) is det
Turn Graph into a connected graph by putting a shared starting point before all vertices.
  225connect_graph([], 0, []) :- !.
  226connect_graph(Graph, Start, [Start-Vertices|Graph]) :-
  227	vertices(Graph, Vertices),
  228	Vertices = [First|_],
  229	before(First, Start).
 before(+Term, -Before) is det
Unify Before to a term that comes before Term in the standard order of terms.
Errors
- instantiation_error if Term is unbound.
  238before(X, _) :-
  239	var(X), !,
  240	instantiation_error(X).
  241before(Number, Start) :-
  242	number(Number), !,
  243	Start is Number - 1.
  244before(_, 0).
  245
  246
  247		 /*******************************
  248		 *	     SATISFIED		*
  249		 *******************************/
 cpack_not_satisfied(+Package, -WhyNot) is semidet
True when WhyNot describes why Package is not satisfied.
  255cpack_not_satisfied(Pack, AllReasons) :-
  256	setof(Due, cpack_not_satisfied_due(Pack, Due), AllReasons).
  257
  258cpack_not_satisfied_due(Package, no_token(Token)) :-
  259	rdf_has(Package, cpack:requires, Req),
  260	(   rdf_is_literal(Req)
  261	->  Token = Req
  262	;   rdf_has(Req, cpack:name, Token)
  263	),
  264	\+ rdf_has(_, cpack:provides, Token).
  265cpack_not_satisfied_due(Package, file(File, Problems)) :-
  266	rdf_has(File, cpack:inPack, Package),
  267	file_not_satisfied(File, Problems).
 file_not_satisfied(+File, -Reasons) is semidet
True when File's conditions are not satisfied due to Reasons.
  274file_not_satisfied(File, AllReasons) :-
  275	setof(Due, file_not_satisfied_due(File, Due), AllReasons).
 file_not_satisfied_due(+File, -Problem)
True when Conflict describes an import problem for File. There are two types of import problems:
double_import(PI, File1, File2)
File imports File1 and File2 using use_module/1, both of which export PI.
locally_defined(PI, File)
A locally defined predicate is also imported from File.
file_not_found(FileRef)
The given symbolic path cannot be found.
To be done
- We do not yet keep track of locally defined predicates
  292% file_imports_pi_from/3 is too aggressive because it does not
  293% deal with use_module/2.
  294%file_not_satisfied_due(File, double_import(PI,File1,File2)) :-
  295%	file_imports_pi_from(File, File1, PI),
  296%	file_imports_pi_from(File, File2, PI),
  297%	File1 @> File2.
  298file_not_satisfied_due(File, file_not_found(FileRef)) :-
  299	rdf_has(File, cpack:usesFile, FileRef),
  300	rdfs_individual_of(FileRef, cpack:'FileRef'),
  301	\+ rdf_has(_, cpack:resolves, FileRef).
  302file_not_satisfied_due(File, predicate_not_found(PI)) :-
  303	LPI = literal(PI),
  304	rdf_has(File, cpack:requiresPredicate, LPI),
  305	\+ file_imports_pi_from(File, _, PI),
  306	\+ file_calls_public_from(File, _, PI),
  307	\+ other_source(PI).
  308
  309other_source(API) :-
  310	atom_to_term(API, PI, []),
  311	pi_head(PI, Head),
  312	(   predicate_property(Head, multifile)
  313	;   predicate_property(Head, autoload(_))
  314	;   predicate_property(Head, public)
  315	), !.
  316
  317pi_head(M:PI, M:Head) :- !,
  318	pi_head(PI, Head).
  319pi_head(Name/Arity, Head) :-
  320	functor(Head, Name, Arity).
 file_imports_from(+File, -Predicates, -From) is nondet
True if File imports Predicates from the file From.
Arguments:
Predicates- is a list of canonical predicate indicators.
  329file_imports_from(File, PIs, From) :-
  330	setof(PI, file_imports_pi_from(File, From, PI), PIs).
  331
  332file_imports_pi_from(File, UsedFile, PI) :-
  333	rdf_has(File, cpack:usesFile, Uses),
  334	(   rdfs_individual_of(Uses, cpack:'FileRef')
  335	->  rdf_has(UsedFile, cpack:resolves, Uses)
  336	;   UsedFile = Uses
  337	),
  338	rdf_has(UsedFile, cpack:exportsPredicate, literal(PI)).
 file_calls_public_from(+File, -UsedFile, +PI) is semidet
True if PI is a module-qualified term that can be called in UsedFile, that is imported from File.
  345file_calls_public_from(File, UsedFile, PI) :-
  346	(   rdf_has(UsedFile, cpack:publicPredicate, literal(PI))
  347	->  true
  348	;   atom_to_term(PI, M:PPI, []),
  349	    rdf_has(UsedFile, cpack:module, literal(M)),
  350	    format(atom(Plain), '~q', [PPI]),
  351	    (	rdf_has(UsedFile, cpack:exportsPredicate, literal(Plain))
  352	    ->	true
  353	    ;	rdf_has(UsedFile, cpack:publicPredicate, literal(Plain))
  354	    )
  355	),
  356	(   rdf_has(File, cpack:usesFile, UsedFile)
  357	->  true
  358	;   rdf_has(UsedFile, cpack:resolves, Uses),
  359	    rdf_has(File, cpack:usesFile, Uses)
  360	), !