View source with formatted comments or as raw
    1/*  Part of ClioPatria SPARQL server
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2012 VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(jena_properties, []).   31:- use_module(library(semweb/rdfs)).   32:- use_module(library(semweb/rdf_db)).   33:- use_module(library(aggregate)).   34:- use_module(sparql_runtime).   35
   36:- multifile
   37	sparql:functional_property/2,
   38	sparql:current_functional_property/3.   39
   40ns(apf,   'http://jena.hpl.hp.com/ARQ/property#').
   41ns(lists, 'http://jena.hpl.hp.com/ARQ/list#').
   42ns(Prefix, URI) :-
   43	rdf_current_ns(Prefix, URI).
   44
   45alias('java:com.hp.hpl.jena.sparql.pfunction.library.',
   46      'http://jena.hpl.hp.com/ARQ/property#').
   47alias('java:com.hp.hpl.jena.query.pfunction.library.',
   48      'http://jena.hpl.hp.com/ARQ/property#').
   49
   50property_alias(Prefix:Local, Global) :-
   51	ns(Prefix, URI),
   52	alias(AliasBase, URI),
   53	atom_concat(AliasBase, Local, Global).
   54
   55absolute_uri(Prefix:Local, Global) :-
   56	ns(Prefix, URI),
   57	atom_concat(URI, Local, Global).
   58
   59term_expansion((sparql:functional_property(S, NS:Term0) :- Body),
   60	       [ (sparql:functional_property(S, Term) :- Body),
   61		 sparql:current_functional_property(P, P, Argc)
   62	       | Aliases
   63	       ]) :-
   64	Term0 =.. [Name|Args],
   65	length(Args, Argc),
   66	absolute_uri(NS:Name, P),
   67	Term =.. [P|Args],
   68	findall(sparql:current_functional_property(P1, P, Argc),
   69		property_alias(NS:Name, P1),
   70		Aliases).
   71
   72
   73		 /*******************************
   74		 *    JENA PROPERTY FUNCTIONS	*
   75		 *******************************/
   76
   77% See http://jena.sourceforge.net/ARQ/library-propfunc.html
   78
   79% (S apf:assign, O) is basically unification.
   80
   81sparql:functional_property(S, apf:assign(O)) :-
   82	(   S = O
   83	->  true
   84	;   sparql_true(S=O)
   85	).
   86
   87
   88		 /*******************************
   89		 *	       LISTS		*
   90		 *******************************/
   91
   92rdf_list(S) :-
   93	rdf_equal(S, rdf:nil).
   94rdf_list(S) :-
   95	rdf(S, rdf:first, _).
   96
   97rdf_container(Container) :-
   98	container_class(Class),
   99	rdfs_individual_of(Container, Class).
  100
  101:- rdf_meta container_class(r).  102
  103container_class(rdf:'Bag').
  104container_class(rdf:'Seq').
  105container_class(rdf:'Alt').
  106
  107% (S, lists:member, O) means that O is a member of the collection S. In
  108% Jena, S may be unbound, finding all lists on the database.
  109
  110sparql:functional_property(S, lists:member(O)) :-
  111	rdf_list(S),
  112	rdfs_member(O, S).
  113
  114sparql:functional_property(S, rdfs:member(O)) :-
  115	rdf_container(S),
  116	rdfs_member(O, S).
  117
  118sparql:functional_property(S, apf:bag(O)) :-
  119	nonvar(S),
  120	rdfs_individual_of(S, rdfs:'Bag'),
  121	rdfs_member(O, S).
  122sparql:functional_property(S, apf:seq(O)) :-
  123	nonvar(S),
  124	rdfs_individual_of(S, rdfs:'Seq'),
  125	rdfs_member(O, S).
  126sparql:functional_property(S, apf:alt(O)) :-
  127	nonvar(S),
  128	rdfs_individual_of(S, rdfs:'Alt'),
  129	rdfs_member(O, S).
  130
  131
  132% (S, lists:length, O) is true when O is the length of the collection S.
  133% Again, S may be unbound.
  134
  135sparql:functional_property(S, lists:length(O)) :-
  136	rdf_list(S),
  137	aggregate_all(count, rdfs_member(_, S), Len),
  138	rdf_equal(xsd:integer, IntType),
  139	atom_number(String, Len),
  140	O = literal(type(IntType, String)).
  141
  142sparql:functional_property(S, lists:index(literal(type(IntType, Index)),
  143					  Element)) :-
  144	rdf_list(S),
  145	rdf_equal(xsd:integer, IntType),
  146	(   var(Index)
  147	->  rdfs_nth1(I, S, Element),
  148	    atom_number(Index, I)
  149	;   atom_number(Index, I),
  150	    rdfs_nth1(I, S, Element)
  151	->  true
  152	).
  153
  154
  155rdfs_nth1(0, Set, Element) :-
  156	rdf_has(Set, rdf:first, Element).
  157rdfs_nth1(I, Set, Element) :-
  158	var(I), !,
  159	rdf_has(Set, rdf:rest, Tail),
  160	rdfs_nth1(I0, Tail, Element),
  161	I is I0 + 1.
  162rdfs_nth1(I, Set, Element) :-
  163	I2 is I - 1,
  164	rdf_has(Set, rdf:rest, Tail),
  165	rdfs_nth1(I2, Tail, Element)