isidorus-cvs
Threads by month
- ----- 2025 -----
- July
- June
- May
- April
- March
- February
- January
- ----- 2024 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2023 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2022 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2021 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2020 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2019 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2018 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2017 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2016 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2015 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2014 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2013 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2012 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2011 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2010 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2009 -----
- December
- November
- October
- September
- August
- July
- June
- May
- April
- March
- February
- January
- ----- 2008 -----
- December
- 1037 discussions
Author: lgiessmann
Date: Fri Feb 11 07:01:37 2011
New Revision: 394
Log:
TM-SPARQL: added the macro with-triple-nodes to reduce code-duplications
Modified:
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Fri Feb 11 07:01:37 2011
@@ -14,6 +14,22 @@
;TODO: create a macro for "filter-for-scopes", "filter-for-reifier", ...
+(defmacro with-triple-nodes (construct &body body)
+ `(let* ((subj (subject ,construct))
+ (pred (predicate ,construct))
+ (obj (object ,construct))
+ (subj-uri (unless (variable-p subj)
+ (sparql-node (value subj) :revision revision)))
+ (pred-uri (unless (variable-p pred)
+ (sparql-node (value pred) :revision revision)))
+ (obj-uri (when (and (not (variable-p obj))
+ (not (literal-p obj)))
+ (sparql-node (value obj) :revision revision)))
+ (literal-datatype (when (literal-p obj)
+ (literal-datatype obj))))
+ (declare (Ignorable subj-uri pred-uri obj-uri literal-datatype))
+ ,@body))
+
(defgeneric filter-by-special-uris (construct &key revision)
(:documentation "Returns lists representing triples that handles special
@@ -82,15 +98,7 @@
represents a role and the object represents a player.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
(unless (literal-p (object construct))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (subj-uri (unless (variable-p subj)
- (sparql-node (value subj) :revision revision)))
- (pred-uri (unless (variable-p pred)
- (sparql-node (value pred) :revision revision)))
- (obj-uri (unless (variable-p obj)
- (sparql-node (value obj) :revision revision))))
+ (with-triple-nodes construct
(when (and (or (typep (value subj) 'RoleC)
(variable-p subj))
(or (typep (value obj) 'TopicC)
@@ -136,15 +144,7 @@
an Association and the object represents a role.")
(:method((construct SPARQL-Triple) &key (revision *TM-REVISION*))
(unless (literal-p (object construct))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (subj-uri (unless (variable-p subj)
- (sparql-node (value subj) :revision revision)))
- (pred-uri (unless (variable-p pred)
- (sparql-node (value pred) :revision revision)))
- (obj-uri (unless (variable-p obj)
- (sparql-node (value obj) :revision revision))))
+ (with-triple-nodes construct
(when (and (or (variable-p subj)
(typep (value subj) 'd:AssociationC))
(or (variable-p obj)
@@ -187,15 +187,7 @@
a topic and the object represents a name or occurrence.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
(unless (literal-p (object construct))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (subj-uri (unless (variable-p subj)
- (sparql-node (value subj) :revision revision)))
- (pred-uri (unless (variable-p pred)
- (sparql-node (value pred) :revision revision)))
- (obj-uri (unless (variable-p obj)
- (sparql-node (value obj) :revision revision))))
+ (with-triple-nodes construct
(when (and (or (variable-p subj)
(typep (value subj) 'd:TopicC))
(or (variable-p obj)
@@ -247,14 +239,7 @@
subject and its literal value as object.")
(:method ((construct SPARQL-Triple) &key revision)
(declare (ignorable revision))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (literal-datatype (literal-datatype obj))
- (subj-uri (unless (variable-p subj)
- (sparql-node (value subj) :revision revision)))
- (pred-uri (unless (variable-p pred)
- (sparql-node(value pred) :revision revision))))
+ (with-triple-nodes construct
(when (and (or (variable-p subj)
(typep (value subj) 'd:OccurrenceC)
(typep (value subj) 'd:NameC)
@@ -304,15 +289,7 @@
scoped item and the object as the scope-topic.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
(unless (literal-p (object construct))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (subj-uri (unless (variable-p subj)
- (sparql-node (value subj) :revision revision)))
- (pred-uri (unless (variable-p pred)
- (sparql-node (value pred) :revision revision)))
- (obj-uri (unless (variable-p obj)
- (sparql-node (value obj) :revision revision))))
+ (with-triple-nodes construct
(when (and (or (variable-p subj)
(typep (value subj) 'd:ScopableC))
(or (variable-p obj)
@@ -360,15 +337,7 @@
and the corresponding reified construct.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
(unless (literal-p (object construct))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (subj-uri (unless (variable-p subj)
- (sparql-node (value subj) :revision revision)))
- (pred-uri (unless (variable-p pred)
- (sparql-node (value pred) :revision revision)))
- (obj-uri (unless (variable-p obj)
- (sparql-node (value obj) :revision revision))))
+ (with-triple-nodes construct
(when (and (or (variable-p subj)
(typep (value subj) 'd:ReifiableConstructC))
(or (variable-p obj)
1
0
Author: lgiessmann
Date: Tue Feb 8 09:58:10 2011
New Revision: 393
Log:
TM-SPARQL: finished the TM-SPARQL-interface, i.e. the handling of special-uris defined in the tmsparql proposal (unit-tests are missing currently); fixed a bug with type failures => now all constructs are checked, i.e. the corresponding operation is only performed if the type is as expected.
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Tue Feb 8 09:58:10 2011
@@ -36,7 +36,7 @@
(concat "<" uri-string ">")
(let ((oid-string (write-to-string (elephant::oid construct)))
(pref (subseq (symbol-name (type-of construct)) 0 1)))
- (concat "_" (string-downcase pref) oid-string))))))
+ (concat "_:" (string-downcase pref) oid-string))))))
(defun init-tm-sparql (&optional (revision (get-revision)))
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Tue Feb 8 09:58:10 2011
@@ -15,32 +15,25 @@
-
(defgeneric filter-by-special-uris (construct &key revision)
(:documentation "Returns lists representing triples that handles special
predicate uris defined in tmsparql.")
(:method ((construct SPARQL-Triple) &key (revision d:*TM-REVISION*))
(let ((pred (predicate construct))
- (subj-value (value (subject construct))))
+ (pred-val (value (predicate construct))))
(if (variable-p pred)
(filter-for-special-uris construct :revision revision)
- (cond ((and (has-identifier (value pred) *tms-reifier*)
- (typep subj-value 'd:ReifiableConstructC))
+ (cond ((has-identifier pred-val *tms-reifier*)
(filter-for-reifier construct :revision revision))
- ((and (has-identifier (value pred) *tms-scope*)
- (typep subj-value 'd:ScopableC))
- (filter-for-special-uris construct :revision revision))
- ((and (has-identifier (value pred) *tms-value*)
- (typep subj-value 'd:CharacteristicC))
+ ((has-identifier pred-val *tms-scope*)
+ (filter-for-scopes construct :revision revision))
+ ((has-identifier pred-val *tms-value*)
(filter-for-values construct :revision revision))
- ((and (has-identifier (value pred) *tms-topicProperty*)
- (typep subj-value 'd:TopicC))
+ ((has-identifier pred-val *tms-topicProperty*)
(filter-for-topicProperties construct :revision revision))
- ((and (has-identifier (value pred) *tms-role*)
- (typep subj-value 'd:AssociationC))
+ ((has-identifier pred-val *tms-role*)
(filter-for-roles construct :revision revision))
- ((and (has-identifier (value pred) *tms-player*)
- (typep subj-value 'd:RoleC))
+ ((has-identifier pred-val *tms-player*)
(filter-for-player construct :revision revision)))))))
@@ -49,39 +42,38 @@
and its objects corresponding to the defined
special-uris, e.g. <subj> var <obj>.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
- (let* ((subj (subject construct))
- (pred (predicate construct))
+ (let* ((pred (predicate construct))
(old-pred-value (value pred))
(res-1
- (when (or (typep (value subj) 'd:ReifiableConstructC)
- (variable-p subj))
+ (progn
(setf (value pred) (get-item-by-psi *tms-reifier* :revision revision))
- (filter-for-reifier construct :revision revision)
- (setf (value pred) old-pred-value)))
+ (let ((val (filter-for-reifier construct :revision revision)))
+ (setf (value pred) old-pred-value)
+ val)))
(res-2
- (when (or (typep (value subj) 'd:ScopableC)
- (variable-p subj))
+ (progn
(setf (value pred) (get-item-by-psi *tms-scope* :revision revision))
- (filter-for-scopes construct :revision revision)
- (setf (value pred) old-pred-value)))
+ (let ((val (filter-for-scopes construct :revision revision)))
+ (setf (value pred) old-pred-value)
+ val)))
(res-3
- (when (or (typep (value subj) 'd:CharacteristicC)
- (variable-p subj))
+ (progn
(setf (value pred) (get-item-by-psi *tms-value* :revision revision))
- (filter-for-values construct :revision revision)
- (setf (value pred) old-pred-value)))
+ (let ((val (filter-for-values construct :revision revision)))
+ (setf (value pred) old-pred-value)
+ val)))
(res-4
- (when (or (typep (value subj) 'd:AssociationC)
- (variable-p subj))
+ (progn
(setf (value pred) (get-item-by-psi *tms-role* :revision revision))
- (filter-for-values construct :revision revision)
- (setf (value pred) old-pred-value)))
+ (let ((val (filter-for-roles construct :revision revision)))
+ (setf (value pred) old-pred-value)
+ val)))
(res-5
- (when (or (typep (value subj) 'd:RoleC)
- (variable-p subj))
+ (progn
(setf (value pred) (get-item-by-psi *tms-player* :revision revision))
- (filter-for-values construct :revision revision)
- (setf (value pred) old-pred-value))))
+ (let ((val (filter-for-player construct :revision revision)))
+ (setf (value pred) old-pred-value)
+ val))))
(append res-1 res-2 res-3 res-4 res-5))))
@@ -99,40 +91,44 @@
(sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
(sparql-node (value obj) :revision revision))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (eql (player (value subj) :revision revision)
- (value obj))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object obj-uri))))
- ((not (variable-p subj))
- (let ((player-top
- (player (value subj) :revision revision)))
- (when player-top
- (list :subject subj-uri
- :predicate pred-uri
- :object (sparql-node player-top :revision revision)))))
- ((not (variable-p obj))
- (let ((parent-roles
- (player-in-roles (value obj) :revision revision)))
- (loop for role in parent-roles
- collect (list :subject (sparql-node role :revision revision)
- :predicate pred-uri
- :object (sparql-node (player role :revision revision)
- :revision revision)))))
- (t ; only pred is given
- (let ((all-roles
- (remove-null
- (map 'list #'(lambda(role)
- (when (player role :revision revision)
- role))
- (get-all-roles revision)))))
- (loop for role in all-roles
- collect (list :subject (sparql-node role :revision revision)
- :predicate pred-uri
- :object (sparql-node (player role :revision revision)
- :revision revision))))))))))
+ (when (and (or (typep (value subj) 'RoleC)
+ (variable-p subj))
+ (or (typep (value obj) 'TopicC)
+ (variable-p obj)))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (eql (player (value subj) :revision revision)
+ (value obj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (let ((player-top
+ (player (value subj) :revision revision)))
+ (when player-top
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (sparql-node player-top :revision revision)))))
+ ((not (variable-p obj))
+ (let ((parent-roles
+ (player-in-roles (value obj) :revision revision)))
+ (loop for role in parent-roles
+ collect (list :subject (sparql-node role :revision revision)
+ :predicate pred-uri
+ :object (sparql-node (player role :revision revision)
+ :revision revision)))))
+ (t ; only pred is given
+ (let ((all-roles
+ (remove-null
+ (map 'list #'(lambda(role)
+ (when (player role :revision revision)
+ role))
+ (get-all-roles revision)))))
+ (loop for role in all-roles
+ collect (list :subject (sparql-node role :revision revision)
+ :predicate pred-uri
+ :object (sparql-node (player role :revision revision)
+ :revision revision)))))))))))
(defgeneric filter-for-roles (construct &key revision)
@@ -149,37 +145,41 @@
(sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
(sparql-node (value obj) :revision revision))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (find obj (roles (value subj) :revision revision))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object obj-uri))))
- ((not (variable-p subj))
- (loop for role in (roles (value subj) :revision revision)
- collect (list :subject subj-uri
- :predicate pred-uri
- :object (sparql-node role :revision revision))))
- ((not (variable-p obj))
- (let ((parent-assoc (parent (value obj) :revision revision)))
- (when revision
- (list :subject (sparql-node parent-assoc :revision revision)
- :predicate pred-uri
- :object obj-uri))))
- (t ; only pred is given
- (let ((assocs
- (remove-null
- (map 'list #'(lambda(assoc)
- (when (roles assoc :revision revision)
- assoc))
- (get-all-associations revision)))))
- (loop for assoc in assocs
+ (when (and (or (variable-p subj)
+ (typep (value subj) 'd:AssociationC))
+ (or (variable-p obj)
+ (typep (value subj) 'd:RoleC)))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (find obj (roles (value subj) :revision revision))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (loop for role in (roles (value subj) :revision revision)
+ collect (list :subject subj-uri
+ :predicate pred-uri
+ :object (sparql-node role :revision revision))))
+ ((not (variable-p obj))
+ (let ((parent-assoc (parent (value obj) :revision revision)))
+ (when revision
+ (list :subject (sparql-node parent-assoc :revision revision)
+ :predicate pred-uri
+ :object obj-uri))))
+ (t ; only pred is given
+ (let ((assocs
+ (remove-null
+ (map 'list #'(lambda(assoc)
+ (when (roles assoc :revision revision)
+ assoc))
+ (get-all-associations revision)))))
+ (loop for assoc in assocs
append (loop for role in (roles assoc :revision revision)
collect (list :subject (sparql-node
assoc :revision revision)
:predicate pred-uri
:object (sparql-node
- role :revision revision)))))))))))
+ role :revision revision))))))))))))
(defgeneric filter-for-topicProperties (construct &key revision)
@@ -196,37 +196,42 @@
(sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
(sparql-node (value obj) :revision revision))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (find obj (append (names (value subj) :revision revision)
- (occurrences (value subj) :revision revision)))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object obj-uri))))
- ((not (variable-p subj))
- (loop for property in (append
- (names (value subj) :revision revision)
- (occurrences (value subj) :revision revision))
- collect (list :subject subj-uri
- :predicate pred-uri
- :object
- (sparql-node property :revision revision))))
- ((not (variable-p obj))
- (let ((parent-top (parent (value obj) :revision revision)))
- (when revision
- (list :subject (sparql-node parent-top :revision revision)
- :predicate pred-uri
- :object obj-uri))))
- (t ; only pred is given
- (let ((topics
- (remove-null
- (map 'list #'(lambda(top)
- (when (append
- (names top :revision revision)
- (occurrences top :revision revision))
- top))
- (get-all-topics revision)))))
- (loop for top in topics
+ (when (and (or (variable-p subj)
+ (typep (value subj) 'd:TopicC))
+ (or (variable-p obj)
+ (typep (value obj) 'd:OccurrenceC)
+ (typep (value obj) 'd:NameC)))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (find obj (append (names (value subj) :revision revision)
+ (occurrences (value subj) :revision revision)))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (loop for property in (append
+ (names (value subj) :revision revision)
+ (occurrences (value subj) :revision revision))
+ collect (list :subject subj-uri
+ :predicate pred-uri
+ :object
+ (sparql-node property :revision revision))))
+ ((not (variable-p obj))
+ (let ((parent-top (parent (value obj) :revision revision)))
+ (when revision
+ (list :subject (sparql-node parent-top :revision revision)
+ :predicate pred-uri
+ :object obj-uri))))
+ (t ; only pred is given
+ (let ((topics
+ (remove-null
+ (map 'list #'(lambda(top)
+ (when (append
+ (names top :revision revision)
+ (occurrences top :revision revision))
+ top))
+ (get-all-topics revision)))))
+ (loop for top in topics
append (loop for prop in (append
(names top :revision revision)
(occurrences top :revision revision))
@@ -234,54 +239,64 @@
top :revision revision)
:predicate pred-uri
:object (sparql-node
- prop :revision revision)))))))))))
+ prop :revision revision))))))))))))
- (defgeneric filter-for-values (construct &key revision)
- (:documentation "Returns a list of triples that represent a
+(defgeneric filter-for-values (construct &key revision)
+ (:documentation "Returns a list of triples that represent a
subject and its literal value as object.")
- (:method ((construct SPARQL-Triple) &key revision)
- (declare (ignorable revision))
- (when (or (literal-p (object construct))
- (variable-p (object construct)))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (literal-datatype (literal-datatype obj))
- (subj-uri (unless (variable-p subj)
- (sparql-node (value subj) :revision revision)))
- (pred-uri (unless (variable-p pred)
- (sparql-node(value pred) :revision revision))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (or (and (typep subj 'NameC)
- (string= literal-datatype *xml-string*)
- (string= (charvalue subj) (value obj)))
- (filter-datatypable-by-value subj obj literal-datatype))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object (value obj)
- :literal-datatype literal-datatype))))
- ((not (variable-p subj))
+ (:method ((construct SPARQL-Triple) &key revision)
+ (declare (ignorable revision))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (literal-datatype (literal-datatype obj))
+ (subj-uri (unless (variable-p subj)
+ (sparql-node (value subj) :revision revision)))
+ (pred-uri (unless (variable-p pred)
+ (sparql-node(value pred) :revision revision))))
+ (when (and (or (variable-p subj)
+ (typep (value subj) 'd:OccurrenceC)
+ (typep (value subj) 'd:NameC)
+ (typep (value subj) 'd:VariantC))
+ (or (variable-p obj)
+ (literal-p obj)))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (or (and (typep subj 'NameC)
+ (string= literal-datatype *xml-string*)
+ (string= (charvalue subj) (value obj)))
+ (filter-datatypable-by-value subj obj literal-datatype))
(list (list :subject subj-uri
:predicate pred-uri
- :object (charvalue subj)
- :literal-datatype (datatype subj))))
- ((not (variable-p obj))
- (loop for char in (return-characteristics (value obj) literal-datatype)
+ :object (value obj)
+ :literal-datatype literal-datatype))))
+ ((not (variable-p subj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object (charvalue subj)
+ :literal-datatype (if (typep subj 'd:NameC)
+ *xml-string*
+ (datatype subj)))))
+ ((not (variable-p obj))
+ (loop for char in (return-characteristics (value obj) literal-datatype)
+ collect (list :subject (sparql-node char :revision revision)
+ :predicate pred-uri
+ :object (charvalue char)
+ :literal-datatype (if (typep char 'd:NameC)
+ *xml-string*
+ (datatype char)))))
+ (t ;only pred is given
+ (let ((chars (append (get-all-names revision)
+ (get-all-occurrences revision)
+ (get-all-variants revision))))
+ (loop for char in chars
collect (list :subject (sparql-node char :revision revision)
:predicate pred-uri
:object (charvalue char)
- :literal-datatype (datatype char))))
- (t ;only pred is given
- (let ((chars (append (get-all-names revision)
- (get-all-occurrences revision)
- (get-all-variants revision))))
- (loop for char in chars
- collect (list :subject (sparql-node char :revision revision)
- :predicate pred-uri
- :object (charvalue char)
- :literal-datatype (datatype char))))))))))
+ :literal-datatype (if (typep char 'd:NameC)
+ *xml-string*
+ (datatype char)))))))))))
(defgeneric filter-for-scopes (construct &key revision)
@@ -298,42 +313,46 @@
(sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
(sparql-node (value obj) :revision revision))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (find obj (themes (value subj) :revision revision))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object obj-uri))))
- ((not (variable-p subj))
- (loop for scope in (themes (value subj) :revision revision)
- collect (list :subject subj-uri
- :predicate pred-uri
- :object (sparql-node scope :revision revision))))
- ((not (variable-p obj))
- (let ((scoped-constructs
- (used-as-theme (value obj) :revision revision)))
- (loop for construct in scoped-constructs
- collect (list :subject (sparql-node construct :revision revision)
+ (when (and (or (variable-p subj)
+ (typep (value subj) 'd:ScopableC))
+ (or (variable-p obj)
+ (typep (value obj) 'd:TopicC)))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (find obj (themes (value subj) :revision revision))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (loop for scope in (themes (value subj) :revision revision)
+ collect (list :subject subj-uri
:predicate pred-uri
- :object obj-uri))))
- (t ;only pred is given
- (let ((scoped-constructs
- (remove-null
- (map 'list #'(lambda(construct)
- (when (themes construct :revision revision)
- construct))
- (append (get-all-associations revision)
- (get-all-occurrences revision)
- (get-all-names revision)
- (get-all-variants))))))
- (loop for construct in scoped-constructs
- append (loop for scope in (themes construct :revision revision)
- collect
- (list :subject (sparql-node
- construct :revision revision)
- :predicate pred-uri
- :object (sparql-node
- construct :revision revision)))))))))))
+ :object (sparql-node scope :revision revision))))
+ ((not (variable-p obj))
+ (let ((scoped-constructs
+ (used-as-theme (value obj) :revision revision)))
+ (loop for construct in scoped-constructs
+ collect (list :subject (sparql-node construct :revision revision)
+ :predicate pred-uri
+ :object obj-uri))))
+ (t ;only pred is given
+ (let ((scoped-constructs
+ (remove-null
+ (map 'list #'(lambda(construct)
+ (when (themes construct :revision revision)
+ construct))
+ (append (get-all-associations revision)
+ (get-all-occurrences revision)
+ (get-all-names revision)
+ (get-all-variants))))))
+ (loop for construct in scoped-constructs
+ append (loop for scope in (themes construct :revision revision)
+ collect
+ (list :subject (sparql-node
+ construct :revision revision)
+ :predicate pred-uri
+ :object (sparql-node
+ construct :revision revision))))))))))))
(defgeneric filter-for-reifier (construct &key revision)
@@ -350,38 +369,42 @@
(sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
(sparql-node (value obj) :revision revision))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (eql (reifier (value subj) :revision revision)
- (value obj))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object obj-uri))))
- ((not (variable-p subj))
- (let ((reifier-top
- (reifier (value subj) :revision revision)))
- (when reifier-top
- (list :subject subj-uri
- :predicate pred-uri
- :object (sparql-node reifier-top :revision revision)))))
- ((not (variable-p obj))
- (let ((reified-cons
- (reified-construct (value obj) :revision revision)))
- (when reified-cons
- (list (list :subject
- (sparql-node reified-cons :revision revision)
+ (when (and (or (variable-p subj)
+ (typep (value subj) 'd:ReifiableConstructC))
+ (or (variable-p obj)
+ (typep (value obj) 'd:TopicC)))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (eql (reifier (value subj) :revision revision)
+ (value obj))
+ (list (list :subject subj-uri
:predicate pred-uri
- :object obj-uri)))))
- (t ; only pred is given
- (let ((topics
- (remove-null
- (map 'list #'(lambda(top)
- (when (reified-construct top :revision revision)
- top))
- (get-all-topics revision)))))
- (loop for top in topics
- collect (list :subject
- (sparql-node (reified-construct top :revision revision)
- :revision revision)
- :predicate pred-uri
- :object (sparql-node top :revision revision))))))))))
\ No newline at end of file
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (let ((reifier-top
+ (reifier (value subj) :revision revision)))
+ (when reifier-top
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (sparql-node reifier-top :revision revision)))))
+ ((not (variable-p obj))
+ (let ((reified-cons
+ (reified-construct (value obj) :revision revision)))
+ (when reified-cons
+ (list (list :subject
+ (sparql-node reified-cons :revision revision)
+ :predicate pred-uri
+ :object obj-uri)))))
+ (t ; only pred is given
+ (let ((topics
+ (remove-null
+ (map 'list #'(lambda(top)
+ (when (reified-construct top :revision revision)
+ top))
+ (get-all-topics revision)))))
+ (loop for top in topics
+ collect (list :subject
+ (sparql-node (reified-construct top :revision revision)
+ :revision revision)
+ :predicate pred-uri
+ :object (sparql-node top :revision revision)))))))))))
\ No newline at end of file
1
0
Author: lgiessmann
Date: Sun Feb 6 17:33:55 2011
New Revision: 392
Log:
TM-SPARQL: added the ability to handle blank nodes, i.e. tm-items without any identifier
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Sun Feb 6 17:33:55 2011
@@ -25,6 +25,20 @@
classes and equality operators.")
+
+(defgeneric sparql-node (construct &key revision)
+ (:documentation "Returns a string of the form <uri> or _t123 that represents
+ a resource node or a blank node.")
+ (:method ((construct TopicMapConstructC) &key (revision d:*TM-REVISION*))
+ (declare (Integer revision))
+ (let ((uri-string (any-id construct :revision revision)))
+ (if uri-string
+ (concat "<" uri-string ">")
+ (let ((oid-string (write-to-string (elephant::oid construct)))
+ (pref (subseq (symbol-name (type-of construct)) 0 1)))
+ (concat "_" (string-downcase pref) oid-string))))))
+
+
(defun init-tm-sparql (&optional (revision (get-revision)))
"Imports the file tmsparql_core_psis.xtm. core_psis.xtm has to be imported
before."
@@ -470,14 +484,6 @@
results)))))
-(defun embrace-uri(uri-string)
- "Returns '<'uri-string'>' if uri-string is not a string uri-string
- is returned as result."
- (if (typep uri-string 'String)
- (concat "<" uri-string ">")
- uri-string))
-
-
(defgeneric filter-by-given-object (construct &key revision)
(:documentation "Returns a list representing a triple that is the result
of a given object.")
@@ -555,15 +561,16 @@
(String literal-datatype))
(remove-null
(map 'list #'(lambda(char)
- (let ((subj (when-do top (parent char :revision revision)
- (any-id top :revision revision)))
- (pred (when-do top (instance-of char :revision revision)
- (any-id top :revision revision))))
- (when (and subj pred)
- (list :subject (embrace-uri subj)
- :predicate (embrace-uri pred)
- :object (charvalue char)
- :literal-datatype literal-datatype))))
+ (let ((subj-uri
+ (when-do top (parent char :revision revision)
+ (sparql-node top :revision revision)))
+ (pred-uri
+ (when-do top (instance-of char :revision revision)
+ (sparql-node top :revision revision))))
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (charvalue char)
+ :literal-datatype literal-datatype)))
(remove-if #'(lambda(char)
(typep char 'VariantC))
(return-characteristics literal-value literal-datatype)))))
@@ -576,26 +583,23 @@
(:method ((construct TopicC) &key (revision *TM-REVISION*))
(declare (Integer revision))
(let ((roles-by-oplayer (player-in-roles construct :revision revision))
- (obj-uri (any-id construct :revision revision)))
+ (obj-uri (sparql-node construct :revision revision)))
(remove-null
(map 'list
#'(lambda(role)
- (let* ((orole
- (when-do assoc (parent role :revision revision)
- (when (= (length (roles assoc :revision revision))
- 2)
- (find-if #'(lambda(r) (not (eql r role)))
- (roles assoc :revision revision)))))
- (pred-uri
- (when-do type (instance-of role :revision revision)
- (any-id type :revision revision)))
- (subj-uri
+ (let ((orole
+ (when-do assoc (parent role :revision revision)
+ (when (= (length (roles assoc :revision revision))
+ 2)
+ (find-if #'(lambda(r) (not (eql r role)))
+ (roles assoc :revision revision))))))
+ (list :subject
(when-do plr (player orole :revision revision)
- (any-id plr :revision revision))))
- (when (and obj-uri pred-uri subj-uri)
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (embrace-uri obj-uri)))))
+ (sparql-node plr :revision revision))
+ :predicate
+ (when-do type (instance-of role :revision revision)
+ (sparql-node type :revision revision))
+ :object obj-uri)))
roles-by-oplayer)))))
@@ -639,29 +643,27 @@
(value (object construct)))
role))
roles-by-type))
- roles-by-type))
- (pred-uri (any-id (value (predicate construct)) :revision revision)))
+ roles-by-type)))
(remove-null
(map 'list
#'(lambda(role)
- (let* ((obj-uri
- (when-do plr-top (player role :revision revision)
- (any-id plr-top :revision revision)))
- (assoc (parent role :revision revision))
+ (let* ((assoc (parent role :revision revision))
(orole (when (and assoc
(= (length
(roles assoc :revision revision))
2))
(find-if #'(lambda(r)
(not (eql r role)))
- (roles assoc :revision revision))))
- (subj-uri
+ (roles assoc :revision revision)))))
+ (list :subject
(when-do plr (player orole :revision revision)
- (any-id plr :revision revision))))
- (when (and subj-uri pred-uri obj-uri)
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (embrace-uri obj-uri)))))
+ (sparql-node plr :revision revision))
+ :predicate
+ (sparql-node (value (predicate construct))
+ :revision revision)
+ :object
+ (when-do plr-top (player role :revision revision)
+ (sparql-node plr-top :revision revision)))))
roles-by-player))))))
@@ -700,17 +702,14 @@
(remove-null
(map 'list
#'(lambda(name)
- (let ((subj
- (when-do top (parent name :revision revision)
- (any-id top :revision revision)))
- (pred
- (when-do top (instance-of name :revision revision)
- (any-id top :revision revision))))
- (when (and subj pred)
- (list :subject (embrace-uri subj)
- :predicate (embrace-uri pred)
- :object (charvalue name)
- :literal-datatype *xml-string*))))
+ (list :subject
+ (when-do top (parent name :revision revision)
+ (sparql-node top :revision revision))
+ :predicate
+ (when-do top (instance-of name :revision revision)
+ (sparql-node top :revision revision))
+ :object (charvalue name)
+ :literal-datatype *xml-string*))
names-by-literal))))))
@@ -740,17 +739,14 @@
(remove-null
(map 'list
#'(lambda(occ)
- (let ((subj
- (when-do top (parent occ :revision revision)
- (any-id top :revision revision)))
- (pred
- (when-do top (instance-of occ :revision revision)
- (any-id top :revision revision))))
- (when (and subj pred)
- (list :subject (embrace-uri subj)
- :predicate (embrace-uri pred)
- :object (charvalue occ)
- :literal-datatype (datatype occ)))))
+ (list :subject
+ (when-do top (parent occ :revision revision)
+ (sparql-node top :revision revision))
+ :predicate
+ (when-do top (instance-of occ :revision revision)
+ (sparql-node top :revision revision))
+ :object (charvalue occ)
+ :literal-datatype (datatype occ)))
all-occs))))))
@@ -895,19 +891,16 @@
#'(lambda(occ)
(filter-occ-by-value occ literal-value literal-datatype))
occs-by-type)))
- (subj-uri (when-do top-uri (any-id construct :revision revision)
- top-uri)))
+ (subj-uri (sparql-node construct :revision revision)))
(remove-null
(map 'list #'(lambda(occ)
- (let ((pred-uri
- (when-do type-top
- (instance-of occ :revision revision)
- (any-id type-top :revision revision))))
- (when pred-uri
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (charvalue occ)
- :literal-datatype (datatype occ)))))
+ (list :subject subj-uri
+ :predicate
+ (when-do type-top
+ (instance-of occ :revision revision)
+ (sparql-node type-top :revision revision))
+ :object (charvalue occ)
+ :literal-datatype (datatype occ)))
all-occs)))))
@@ -930,17 +923,15 @@
:revision revision)
(names construct :revision revision)))
(all-names (intersection by-type by-literal))
- (subj-uri (any-id construct :revision revision)))
+ (subj-uri (sparql-node construct :revision revision)))
(remove-null
(map 'list #'(lambda(name)
- (let ((pred-uri
- (when-do type-top (instance-of name :revision revision)
- (any-id type-top :revision revision))))
- (when pred-uri
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (charvalue name)
- :literal-datatype *xml-string*))))
+ (list :subject subj-uri
+ :predicate
+ (when-do type-top (instance-of name :revision revision)
+ (sparql-node type-top :revision revision))
+ :object (charvalue name)
+ :literal-datatype *xml-string*))
all-names)))))
@@ -975,7 +966,7 @@
(let ((assocs
(associations-of construct nil nil type-top player-top
:revision revision))
- (subj-uri (any-id construct :revision revision)))
+ (subj-uri (sparql-node construct :revision revision)))
(remove-null ;only assocs with two roles can match!
(map 'list
#'(lambda(assoc)
@@ -995,17 +986,16 @@
(when-do
type-top (instance-of other-role
:revision revision)
- (any-id type-top :revision revision))))
+ (sparql-node type-top :revision revision))))
(obj-uri
(when other-role
(when-do player-top (player other-role
:revision revision)
- (any-id player-top :revision revision)))))
- (when (and pred-uri obj-uri)
- (list :subject (embrace-uri subj-uri)
- :predicate (embrace-uri pred-uri)
- :object (embrace-uri obj-uri))))))
+ (sparql-node player-top :revision revision)))))
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
assocs)))))
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 17:33:55 2011
@@ -12,11 +12,6 @@
;TODO: create a macro for "filter-for-scopes", "filter-for-reifier", ...
-;TODO: change (embrace-uri String) to (embrace-construct TopicMapsConstructC)
-; that creates a blank node when there is no identifier available
-; => change also any-id, so if there is no identifier a blank node
-; have to be returned
-; => change all when-do statements that call any-id
@@ -99,14 +94,11 @@
(pred (predicate construct))
(obj (object construct))
(subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (eql (player (value subj) :revision revision)
@@ -120,19 +112,15 @@
(when player-top
(list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id player-top :revision revision)
- (embrace-uri (uri id)))))))
+ :object (sparql-node player-top :revision revision)))))
((not (variable-p obj))
(let ((parent-roles
(player-in-roles (value obj) :revision revision)))
(loop for role in parent-roles
- collect (list :subject (when-do id (any-id role :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node role :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id (player role :revision revision)
- :revision revision)
- (embrace-uri id))))))
+ :object (sparql-node (player role :revision revision)
+ :revision revision)))))
(t ; only pred is given
(let ((all-roles
(remove-null
@@ -141,14 +129,10 @@
role))
(get-all-roles revision)))))
(loop for role in all-roles
- collect (list :subject
- (when-do id (any-id role :revision revision)
- (embrace-uri (uri id)))
+ collect (list :subject (sparql-node role :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id (player role :revision revision)
- :revision revision)
- (embrace-uri id)))))))))))
+ :object (sparql-node (player role :revision revision)
+ :revision revision))))))))))
(defgeneric filter-for-roles (construct &key revision)
@@ -160,14 +144,11 @@
(pred (predicate construct))
(obj (object construct))
(subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (find obj (roles (value subj) :revision revision))
@@ -178,13 +159,11 @@
(loop for role in (roles (value subj) :revision revision)
collect (list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id role :revision revision)
- (embrace-uri id)))))
+ :object (sparql-node role :revision revision))))
((not (variable-p obj))
(let ((parent-assoc (parent (value obj) :revision revision)))
(when revision
- (list :subject (when-do id (any-id parent-assoc :revision revision)
- (embrace-uri id))
+ (list :subject (sparql-node parent-assoc :revision revision)
:predicate pred-uri
:object obj-uri))))
(t ; only pred is given
@@ -196,15 +175,11 @@
(get-all-associations revision)))))
(loop for assoc in assocs
append (loop for role in (roles assoc :revision revision)
- collect (list :subject
- (when-do id (any-id assoc
- :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node
+ assoc :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id role
- :revision revision)
- (embrace-uri id))))))))))))
+ :object (sparql-node
+ role :revision revision)))))))))))
(defgeneric filter-for-topicProperties (construct &key revision)
@@ -216,14 +191,11 @@
(pred (predicate construct))
(obj (object construct))
(subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (find obj (append (names (value subj) :revision revision)
@@ -237,13 +209,12 @@
(occurrences (value subj) :revision revision))
collect (list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id property :revision revision)
- (embrace-uri id)))))
+ :object
+ (sparql-node property :revision revision))))
((not (variable-p obj))
(let ((parent-top (parent (value obj) :revision revision)))
(when revision
- (list :subject (when-do id (any-id parent-top :revision revision)
- (embrace-uri id))
+ (list :subject (sparql-node parent-top :revision revision)
:predicate pred-uri
:object obj-uri))))
(t ; only pred is given
@@ -259,13 +230,11 @@
append (loop for prop in (append
(names top :revision revision)
(occurrences top :revision revision))
- collect (list :subject
- (when-do id (any-id top :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node
+ top :revision revision)
:predicate pred-uri
- :object
- (when-do id (any-id prop :revision revision)
- (embrace-uri id))))))))))))
+ :object (sparql-node
+ prop :revision revision)))))))))))
(defgeneric filter-for-values (construct &key revision)
@@ -280,11 +249,9 @@
(obj (object construct))
(literal-datatype (literal-datatype obj))
(subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node(value pred) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (or (and (typep subj 'NameC)
@@ -302,8 +269,7 @@
:literal-datatype (datatype subj))))
((not (variable-p obj))
(loop for char in (return-characteristics (value obj) literal-datatype)
- collect (list :subject (when-do id (any-id char :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node char :revision revision)
:predicate pred-uri
:object (charvalue char)
:literal-datatype (datatype char))))
@@ -312,8 +278,7 @@
(get-all-occurrences revision)
(get-all-variants revision))))
(loop for char in chars
- collect (list :subject (when-do id (any-id char :revision revision)
- (embrace-uri id))
+ collect (list :subject (sparql-node char :revision revision)
:predicate pred-uri
:object (charvalue char)
:literal-datatype (datatype char))))))))))
@@ -328,14 +293,11 @@
(pred (predicate construct))
(obj (object construct))
(subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value subj) :revision revision)))
(pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
+ (sparql-node (value pred) :revision revision)))
(obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
+ (sparql-node (value obj) :revision revision))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
(when (find obj (themes (value subj) :revision revision))
@@ -346,14 +308,12 @@
(loop for scope in (themes (value subj) :revision revision)
collect (list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id scope :revision revision)
- (embrace-uri (uri id))))))
+ :object (sparql-node scope :revision revision))))
((not (variable-p obj))
(let ((scoped-constructs
(used-as-theme (value obj) :revision revision)))
(loop for construct in scoped-constructs
- collect (list :subject (when-do id (any-id construct :revision revision)
- (embrace-uri (uri id)))
+ collect (list :subject (sparql-node construct :revision revision)
:predicate pred-uri
:object obj-uri))))
(t ;only pred is given
@@ -369,68 +329,59 @@
(loop for construct in scoped-constructs
append (loop for scope in (themes construct :revision revision)
collect
- (list :subject (when-do id (any-id construct
- :revision revision)
- (embrace-uri id))
+ (list :subject (sparql-node
+ construct :revision revision)
:predicate pred-uri
- :object (when-do id (any-id construct
- :revision revision)
- (embrace-uri id))))))))))))
+ :object (sparql-node
+ construct :revision revision)))))))))))
- (defgeneric filter-for-reifier (construct &key revision)
- (:documentation "Returns a list with triples representing a reifier
+(defgeneric filter-for-reifier (construct &key revision)
+ (:documentation "Returns a list with triples representing a reifier
and the corresponding reified construct.")
- (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
- (unless (literal-p (object construct))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
- (pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
- (obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (eql (reifier (value subj) :revision revision)
- (value obj))
- (list (list :subject subj-uri
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (unless (literal-p (object construct))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (subj-uri (unless (variable-p subj)
+ (sparql-node (value subj) :revision revision)))
+ (pred-uri (unless (variable-p pred)
+ (sparql-node (value pred) :revision revision)))
+ (obj-uri (unless (variable-p obj)
+ (sparql-node (value obj) :revision revision))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (eql (reifier (value subj) :revision revision)
+ (value obj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (let ((reifier-top
+ (reifier (value subj) :revision revision)))
+ (when reifier-top
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (sparql-node reifier-top :revision revision)))))
+ ((not (variable-p obj))
+ (let ((reified-cons
+ (reified-construct (value obj) :revision revision)))
+ (when reified-cons
+ (list (list :subject
+ (sparql-node reified-cons :revision revision)
:predicate pred-uri
- :object obj-uri))))
- ((not (variable-p subj))
- (let ((reifier-top
- (reifier (value subj) :revision revision)))
- (when reifier-top
- (list :subject subj-uri
- :predicate pred-uri
- :object (when-do id (any-id reifier-top :revision revision)
- (embrace-uri (uri id)))))))
- ((not (variable-p obj))
- (let ((reified-cons
- (reified-construct (value obj) :revision revision)))
- (when reified-cons
- (list (list :subject
- (when-do id (any-id reified-cons :revision revision)
- (embrace-uri (uri id)))
- :predicate pred-uri
- :object obj-uri)))))
- (t ; only pred is given
- (let ((topics
- (remove-null
- (map 'list #'(lambda(top)
- (when (reified-construct top :revision revision)
- top))
- (get-all-topics revision)))))
- (loop for top in topics
- collect (list :subject
- (when-do id (any-id (reified-construct
- top :revision revision))
- (embrace-uri (uri id)))
- :predicate pred-uri
- :object (when-do id (any-id top :revision revision)
- (embrace-uri (uri id))))))))))))
\ No newline at end of file
+ :object obj-uri)))))
+ (t ; only pred is given
+ (let ((topics
+ (remove-null
+ (map 'list #'(lambda(top)
+ (when (reified-construct top :revision revision)
+ top))
+ (get-all-topics revision)))))
+ (loop for top in topics
+ collect (list :subject
+ (sparql-node (reified-construct top :revision revision)
+ :revision revision)
+ :predicate pred-uri
+ :object (sparql-node top :revision revision))))))))))
\ No newline at end of file
1
0
Author: lgiessmann
Date: Sun Feb 6 06:14:37 2011
New Revision: 391
Log:
TM-SPARQL: added a method to process special-uris in queries of the form <subj> ? <obj>, <subj> ? ?, or ? ? <obj>
Modified:
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 06:14:37 2011
@@ -12,7 +12,6 @@
;TODO: create a macro for "filter-for-scopes", "filter-for-reifier", ...
-;TODO: filter-by-special-uris
;TODO: change (embrace-uri String) to (embrace-construct TopicMapsConstructC)
; that creates a blank node when there is no identifier available
; => change also any-id, so if there is no identifier a blank node
@@ -37,7 +36,7 @@
(typep subj-value 'd:ScopableC))
(filter-for-special-uris construct :revision revision))
((and (has-identifier (value pred) *tms-value*)
- (typep subj-value 'd:TopicC))
+ (typep subj-value 'd:CharacteristicC))
(filter-for-values construct :revision revision))
((and (has-identifier (value pred) *tms-topicProperty*)
(typep subj-value 'd:TopicC))
@@ -52,17 +51,43 @@
(defgeneric filter-for-special-uris (construct &key revision)
(:documentation "Returns a list of triples representing the subject
- and its objects correponding to the defined
+ and its objects corresponding to the defined
special-uris, e.g. <subj> var <obj>.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
- ;;TODO: implement => type-checking
- ;; *tms-reifier*
- ;; *tms-scope*
- ;; *tms-value* => only when there is <occ|var|nam> ? <LITERAL>, otherwise the predicate is the type of the characteristic
- ;; *tms-topicProperty* ??
- ;; *tms-role*
- ;; *tms-player*
- ))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (old-pred-value (value pred))
+ (res-1
+ (when (or (typep (value subj) 'd:ReifiableConstructC)
+ (variable-p subj))
+ (setf (value pred) (get-item-by-psi *tms-reifier* :revision revision))
+ (filter-for-reifier construct :revision revision)
+ (setf (value pred) old-pred-value)))
+ (res-2
+ (when (or (typep (value subj) 'd:ScopableC)
+ (variable-p subj))
+ (setf (value pred) (get-item-by-psi *tms-scope* :revision revision))
+ (filter-for-scopes construct :revision revision)
+ (setf (value pred) old-pred-value)))
+ (res-3
+ (when (or (typep (value subj) 'd:CharacteristicC)
+ (variable-p subj))
+ (setf (value pred) (get-item-by-psi *tms-value* :revision revision))
+ (filter-for-values construct :revision revision)
+ (setf (value pred) old-pred-value)))
+ (res-4
+ (when (or (typep (value subj) 'd:AssociationC)
+ (variable-p subj))
+ (setf (value pred) (get-item-by-psi *tms-role* :revision revision))
+ (filter-for-values construct :revision revision)
+ (setf (value pred) old-pred-value)))
+ (res-5
+ (when (or (typep (value subj) 'd:RoleC)
+ (variable-p subj))
+ (setf (value pred) (get-item-by-psi *tms-player* :revision revision))
+ (filter-for-values construct :revision revision)
+ (setf (value pred) old-pred-value))))
+ (append res-1 res-2 res-3 res-4 res-5))))
(defgeneric filter-for-player (construct &key revision)
1
0
Author: lgiessmann
Date: Sun Feb 6 05:17:44 2011
New Revision: 390
Log:
TM-SPARQL: added a method to process the special uri tms:player
Modified:
trunk/src/TM-SPARQL/sparql_special_uris.lisp
trunk/src/model/datamodel.lisp
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 05:17:44 2011
@@ -47,8 +47,7 @@
(filter-for-roles construct :revision revision))
((and (has-identifier (value pred) *tms-player*)
(typep subj-value 'd:RoleC))
- nil) ;TODO: implement
- )))))
+ (filter-for-player construct :revision revision)))))))
(defgeneric filter-for-special-uris (construct &key revision)
@@ -66,6 +65,67 @@
))
+(defgeneric filter-for-player (construct &key revision)
+ (:documentation "Returns a list with triples where the subject
+ represents a role and the object represents a player.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (unless (literal-p (object construct))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id)))))
+ (obj-uri (unless (variable-p obj)
+ (when-do id (any-id (value obj) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (eql (player (value subj) :revision revision)
+ (value obj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (let ((player-top
+ (player (value subj) :revision revision)))
+ (when player-top
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (when-do id (any-id player-top :revision revision)
+ (embrace-uri (uri id)))))))
+ ((not (variable-p obj))
+ (let ((parent-roles
+ (player-in-roles (value obj) :revision revision)))
+ (loop for role in parent-roles
+ collect (list :subject (when-do id (any-id role :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object
+ (when-do id (any-id (player role :revision revision)
+ :revision revision)
+ (embrace-uri id))))))
+ (t ; only pred is given
+ (let ((all-roles
+ (remove-null
+ (map 'list #'(lambda(role)
+ (when (player role :revision revision)
+ role))
+ (get-all-roles revision)))))
+ (loop for role in all-roles
+ collect (list :subject
+ (when-do id (any-id role :revision revision)
+ (embrace-uri (uri id)))
+ :predicate pred-uri
+ :object
+ (when-do id (any-id (player role :revision revision)
+ :revision revision)
+ (embrace-uri id)))))))))))
+
+
(defgeneric filter-for-roles (construct &key revision)
(:documentation "Returns a list of triples where the subject represents
an Association and the object represents a role.")
@@ -294,8 +354,8 @@
(defgeneric filter-for-reifier (construct &key revision)
- (:documentation "Returns a list with one triple representing a reifier
- and the corresponding reified construct.")
+ (:documentation "Returns a list with triples representing a reifier
+ and the corresponding reified construct.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
(unless (literal-p (object construct))
(let* ((subj (subject construct))
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Sun Feb 6 05:17:44 2011
@@ -154,6 +154,7 @@
:rec-remf
:get-all-topics
:get-all-associations
+ :get-all-roles
:get-all-occurrences
:get-all-names
:get-all-variants
@@ -763,6 +764,10 @@
(get-db-instances-by-class 'AssociationC :revision revision))
+(defun get-all-roles (&optional (revision *TM-REVISION*))
+ (get-db-instances-by-class 'RoleC :revision revision))
+
+
(defun get-all-occurrences (&optional (revision *TM-REVISION*))
(get-db-instances-by-class 'OccurrenceC :revision revision))
1
0
Author: lgiessmann
Date: Sun Feb 6 05:05:13 2011
New Revision: 389
Log:
TM-SPARQL: added a method to process the special uri tms:role
Modified:
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 05:05:13 2011
@@ -44,7 +44,7 @@
(filter-for-topicProperties construct :revision revision))
((and (has-identifier (value pred) *tms-role*)
(typep subj-value 'd:AssociationC))
- nil) ;TODO: implement
+ (filter-for-roles construct :revision revision))
((and (has-identifier (value pred) *tms-player*)
(typep subj-value 'd:RoleC))
nil) ;TODO: implement
@@ -56,14 +56,72 @@
and its objects correponding to the defined
special-uris, e.g. <subj> var <obj>.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
- ;;TODO: implement
+ ;;TODO: implement => type-checking
;; *tms-reifier*
;; *tms-scope*
;; *tms-value* => only when there is <occ|var|nam> ? <LITERAL>, otherwise the predicate is the type of the characteristic
;; *tms-topicProperty* ??
+ ;; *tms-role*
+ ;; *tms-player*
))
+(defgeneric filter-for-roles (construct &key revision)
+ (:documentation "Returns a list of triples where the subject represents
+ an Association and the object represents a role.")
+ (:method((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (unless (literal-p (object construct))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id)))))
+ (obj-uri (unless (variable-p obj)
+ (when-do id (any-id (value obj) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (find obj (roles (value subj) :revision revision))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (loop for role in (roles (value subj) :revision revision)
+ collect (list :subject subj-uri
+ :predicate pred-uri
+ :object (when-do id (any-id role :revision revision)
+ (embrace-uri id)))))
+ ((not (variable-p obj))
+ (let ((parent-assoc (parent (value obj) :revision revision)))
+ (when revision
+ (list :subject (when-do id (any-id parent-assoc :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object obj-uri))))
+ (t ; only pred is given
+ (let ((assocs
+ (remove-null
+ (map 'list #'(lambda(assoc)
+ (when (roles assoc :revision revision)
+ assoc))
+ (get-all-associations revision)))))
+ (loop for assoc in assocs
+ append (loop for role in (roles assoc :revision revision)
+ collect (list :subject
+ (when-do id (any-id assoc
+ :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object
+ (when-do id (any-id role
+ :revision revision)
+ (embrace-uri id))))))))))))
+
+
(defgeneric filter-for-topicProperties (construct &key revision)
(:documentation "Returns a list of triples where the subject represents
a topic and the object represents a name or occurrence.")
@@ -83,20 +141,21 @@
(embrace-uri (uri id))))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
- (when (find obj (append (names subj :revision revision)
- (occurrences subj :revision revision)))
+ (when (find obj (append (names (value subj) :revision revision)
+ (occurrences (value subj) :revision revision)))
(list (list :subject subj-uri
:predicate pred-uri
:object obj-uri))))
((not (variable-p subj))
- (loop for property in (append (names subj :revision revision)
- (occurrences subj :revision revision))
+ (loop for property in (append
+ (names (value subj) :revision revision)
+ (occurrences (value subj) :revision revision))
collect (list :subject subj-uri
:predicate pred-uri
:object (when-do id (any-id property :revision revision)
(embrace-uri id)))))
((not (variable-p obj))
- (let ((parent-top (parent obj :revision revision)))
+ (let ((parent-top (parent (value obj) :revision revision)))
(when revision
(list :subject (when-do id (any-id parent-top :revision revision)
(embrace-uri id))
@@ -145,11 +204,11 @@
(not (variable-p obj)))
(when (or (and (typep subj 'NameC)
(string= literal-datatype *xml-string*)
- (string= (charvalue subj) obj))
+ (string= (charvalue subj) (value obj)))
(filter-datatypable-by-value subj obj literal-datatype))
(list (list :subject subj-uri
:predicate pred-uri
- :object obj
+ :object (value obj)
:literal-datatype literal-datatype))))
((not (variable-p subj))
(list (list :subject subj-uri
@@ -157,7 +216,7 @@
:object (charvalue subj)
:literal-datatype (datatype subj))))
((not (variable-p obj))
- (loop for char in (return-characteristics obj literal-datatype)
+ (loop for char in (return-characteristics (value obj) literal-datatype)
collect (list :subject (when-do id (any-id char :revision revision)
(embrace-uri id))
:predicate pred-uri
@@ -194,12 +253,12 @@
(embrace-uri (uri id))))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
- (when (find obj (themes subj :revision revision))
+ (when (find obj (themes (value subj) :revision revision))
(list (list :subject subj-uri
:predicate pred-uri
:object obj-uri))))
((not (variable-p subj))
- (loop for scope in (themes subj :revision revision)
+ (loop for scope in (themes (value subj) :revision revision)
collect (list :subject subj-uri
:predicate pred-uri
:object (when-do id (any-id scope :revision revision)
1
0
Author: lgiessmann
Date: Sun Feb 6 04:48:58 2011
New Revision: 388
Log:
TM-SPARQL: added type checking when processing special-uris to avoid exception at runtime
Modified:
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 04:48:58 2011
@@ -26,20 +26,27 @@
(:documentation "Returns lists representing triples that handles special
predicate uris defined in tmsparql.")
(:method ((construct SPARQL-Triple) &key (revision d:*TM-REVISION*))
- (let ((pred (predicate construct)))
+ (let ((pred (predicate construct))
+ (subj-value (value (subject construct))))
(if (variable-p pred)
(filter-for-special-uris construct :revision revision)
- (cond ((has-identifier (value pred) *tms-reifier*)
+ (cond ((and (has-identifier (value pred) *tms-reifier*)
+ (typep subj-value 'd:ReifiableConstructC))
(filter-for-reifier construct :revision revision))
- ((has-identifier (value pred) *tms-scope*)
+ ((and (has-identifier (value pred) *tms-scope*)
+ (typep subj-value 'd:ScopableC))
(filter-for-special-uris construct :revision revision))
- ((has-identifier (value pred) *tms-value*)
+ ((and (has-identifier (value pred) *tms-value*)
+ (typep subj-value 'd:TopicC))
(filter-for-values construct :revision revision))
- ((has-identifier (value pred) *tms-topicProperty*)
+ ((and (has-identifier (value pred) *tms-topicProperty*)
+ (typep subj-value 'd:TopicC))
(filter-for-topicProperties construct :revision revision))
- ((has-identifier (value pred) *tms-role*)
+ ((and (has-identifier (value pred) *tms-role*)
+ (typep subj-value 'd:AssociationC))
nil) ;TODO: implement
- ((has-identifier (value pred) *tms-player*)
+ ((and (has-identifier (value pred) *tms-player*)
+ (typep subj-value 'd:RoleC))
nil) ;TODO: implement
)))))
1
0
Author: lgiessmann
Date: Sun Feb 6 04:41:31 2011
New Revision: 387
Log:
TM-SPARQL: added a method to process the special uri tms:topicProperty
Modified:
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_special_uris.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Sun Feb 6 04:41:31 2011
@@ -39,6 +39,8 @@
(filter-for-topicProperties construct :revision revision))
((has-identifier (value pred) *tms-role*)
nil) ;TODO: implement
+ ((has-identifier (value pred) *tms-player*)
+ nil) ;TODO: implement
)))))
@@ -51,72 +53,14 @@
;; *tms-reifier*
;; *tms-scope*
;; *tms-value* => only when there is <occ|var|nam> ? <LITERAL>, otherwise the predicate is the type of the characteristic
- ;; *tms-topicProperty*
+ ;; *tms-topicProperty* ??
))
+
(defgeneric filter-for-topicProperties (construct &key revision)
(:documentation "Returns a list of triples where the subject represents
a topic and the object represents a name or occurrence.")
(:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
- ;TODO: implement
- ))
-
-
-(defgeneric filter-for-values (construct &key revision)
- (:documentation "Returns a list of triples that represent a
- subject and its literal value as object.")
- (:method ((construct SPARQL-Triple) &key revision)
- (declare (ignorable revision))
- (when (or (literal-p (object construct))
- (variable-p (object construct)))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (literal-datatype (literal-datatype obj))
- (subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
- (pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id))))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (or (and (typep subj 'NameC)
- (string= literal-datatype *xml-string*)
- (string= (charvalue subj) obj))
- (filter-datatypable-by-value subj obj literal-datatype))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object obj
- :literal-datatype literal-datatype))))
- ((not (variable-p subj))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object (charvalue subj)
- :literal-datatype (datatype subj))))
- ((not (variable-p obj))
- (loop for char in (return-characteristics obj literal-datatype)
- collect (list :subject (when-do id (any-id char :revision revision)
- (embrace-uri id))
- :predicate pred-uri
- :object (charvalue char)
- :literal-datatype (datatype char))))
- (t ;only pred is given
- (let ((chars (append (get-all-names revision)
- (get-all-occurrences revision)
- (get-all-variants revision))))
- (loop for char in chars
- collect (list :subject (when-do id (any-id char :revision revision)
- (embrace-uri id))
- :predicate pred-uri
- :object (charvalue char)
- :literal-datatype (datatype char))))))))))
-
-
-(defgeneric filter-for-scopes (construct &key revision)
- (:documentation "Returns a list of triples that represent a subject as the
- scoped item and the object as the scope-topic.")
- (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
(unless (literal-p (object construct))
(let* ((subj (subject construct))
(pred (predicate construct))
@@ -132,99 +76,210 @@
(embrace-uri (uri id))))))
(cond ((and (not (variable-p subj))
(not (variable-p obj)))
- (when (find obj (themes subj :revision revision))
+ (when (find obj (append (names subj :revision revision)
+ (occurrences subj :revision revision)))
(list (list :subject subj-uri
:predicate pred-uri
:object obj-uri))))
((not (variable-p subj))
- (loop for scope in (themes subj :revision revision)
+ (loop for property in (append (names subj :revision revision)
+ (occurrences subj :revision revision))
collect (list :subject subj-uri
:predicate pred-uri
- :object (when-do id (any-id scope :revision revision)
- (embrace-uri (uri id))))))
+ :object (when-do id (any-id property :revision revision)
+ (embrace-uri id)))))
((not (variable-p obj))
- (let ((scoped-constructs
- (used-as-theme (value obj) :revision revision)))
- (loop for construct in scoped-constructs
- collect (list :subject (when-do id (any-id construct :revision revision)
- (embrace-uri (uri id)))
- :predicate pred-uri
- :object obj-uri))))
- (t ;only pred is given
- (let ((scoped-constructs
- (remove-null
- (map 'list #'(lambda(construct)
- (when (themes construct :revision revision)
- construct))
- (append (get-all-associations revision)
- (get-all-occurrences revision)
- (get-all-names revision)
- (get-all-variants))))))
- (loop for construct in scoped-constructs
- append (loop for scope in (themes construct :revision revision)
- collect
- (list :subject (when-do id (any-id construct
- :revision revision)
- (embrace-uri id))
- :predicate pred-uri
- :object (when-do id (any-id construct
- :revision revision)
- (embrace-uri id))))))))))))
-
-
-(defgeneric filter-for-reifier (construct &key revision)
- (:documentation "Returns a list with one triple representing a reifier
- and the corresponding reified construct.")
- (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
- (unless (literal-p (object construct))
- (let* ((subj (subject construct))
- (pred (predicate construct))
- (obj (object construct))
- (subj-uri (unless (variable-p subj)
- (when-do id (any-id (value subj) :revision revision)
- (embrace-uri (uri id)))))
- (pred-uri (unless (variable-p pred)
- (when-do id (any-id (value pred) :revision revision)
- (embrace-uri (uri id)))))
- (obj-uri (unless (variable-p obj)
- (when-do id (any-id (value obj) :revision revision)
- (embrace-uri (uri id))))))
- (cond ((and (not (variable-p subj))
- (not (variable-p obj)))
- (when (eql (reifier (value subj) :revision revision)
- (value obj))
- (list (list :subject subj-uri
- :predicate pred-uri
- :object obj-uri))))
- ((not (variable-p subj))
- (let ((reifier-top
- (reifier (value subj) :revision revision)))
- (when reifier-top
- (list :subject subj-uri
+ (let ((parent-top (parent obj :revision revision)))
+ (when revision
+ (list :subject (when-do id (any-id parent-top :revision revision)
+ (embrace-uri id))
:predicate pred-uri
- :object (when-do id (any-id reifier-top :revision revision)
- (embrace-uri (uri id)))))))
- ((not (variable-p obj))
- (let ((reified-cons
- (reified-construct (value obj) :revision revision)))
- (when reified-cons
- (list (list :subject
- (when-do id (any-id reified-cons :revision revision)
- (embrace-uri (uri id)))
- :predicate pred-uri
- :object obj-uri)))))
+ :object obj-uri))))
(t ; only pred is given
(let ((topics
(remove-null
(map 'list #'(lambda(top)
- (when (reified-construct top :revision revision)
+ (when (append
+ (names top :revision revision)
+ (occurrences top :revision revision))
top))
(get-all-topics revision)))))
(loop for top in topics
- collect (list :subject
- (when-do id (any-id (reified-construct
- top :revision revision))
- (embrace-uri (uri id)))
+ append (loop for prop in (append
+ (names top :revision revision)
+ (occurrences top :revision revision))
+ collect (list :subject
+ (when-do id (any-id top :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object
+ (when-do id (any-id prop :revision revision)
+ (embrace-uri id))))))))))))
+
+
+ (defgeneric filter-for-values (construct &key revision)
+ (:documentation "Returns a list of triples that represent a
+ subject and its literal value as object.")
+ (:method ((construct SPARQL-Triple) &key revision)
+ (declare (ignorable revision))
+ (when (or (literal-p (object construct))
+ (variable-p (object construct)))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (literal-datatype (literal-datatype obj))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (or (and (typep subj 'NameC)
+ (string= literal-datatype *xml-string*)
+ (string= (charvalue subj) obj))
+ (filter-datatypable-by-value subj obj literal-datatype))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj
+ :literal-datatype literal-datatype))))
+ ((not (variable-p subj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object (charvalue subj)
+ :literal-datatype (datatype subj))))
+ ((not (variable-p obj))
+ (loop for char in (return-characteristics obj literal-datatype)
+ collect (list :subject (when-do id (any-id char :revision revision)
+ (embrace-uri id))
:predicate pred-uri
- :object (when-do id (any-id top :revision revision)
- (embrace-uri (uri id))))))))))))
\ No newline at end of file
+ :object (charvalue char)
+ :literal-datatype (datatype char))))
+ (t ;only pred is given
+ (let ((chars (append (get-all-names revision)
+ (get-all-occurrences revision)
+ (get-all-variants revision))))
+ (loop for char in chars
+ collect (list :subject (when-do id (any-id char :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object (charvalue char)
+ :literal-datatype (datatype char))))))))))
+
+
+ (defgeneric filter-for-scopes (construct &key revision)
+ (:documentation "Returns a list of triples that represent a subject as the
+ scoped item and the object as the scope-topic.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (unless (literal-p (object construct))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id)))))
+ (obj-uri (unless (variable-p obj)
+ (when-do id (any-id (value obj) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (find obj (themes subj :revision revision))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (loop for scope in (themes subj :revision revision)
+ collect (list :subject subj-uri
+ :predicate pred-uri
+ :object (when-do id (any-id scope :revision revision)
+ (embrace-uri (uri id))))))
+ ((not (variable-p obj))
+ (let ((scoped-constructs
+ (used-as-theme (value obj) :revision revision)))
+ (loop for construct in scoped-constructs
+ collect (list :subject (when-do id (any-id construct :revision revision)
+ (embrace-uri (uri id)))
+ :predicate pred-uri
+ :object obj-uri))))
+ (t ;only pred is given
+ (let ((scoped-constructs
+ (remove-null
+ (map 'list #'(lambda(construct)
+ (when (themes construct :revision revision)
+ construct))
+ (append (get-all-associations revision)
+ (get-all-occurrences revision)
+ (get-all-names revision)
+ (get-all-variants))))))
+ (loop for construct in scoped-constructs
+ append (loop for scope in (themes construct :revision revision)
+ collect
+ (list :subject (when-do id (any-id construct
+ :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object (when-do id (any-id construct
+ :revision revision)
+ (embrace-uri id))))))))))))
+
+
+ (defgeneric filter-for-reifier (construct &key revision)
+ (:documentation "Returns a list with one triple representing a reifier
+ and the corresponding reified construct.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (unless (literal-p (object construct))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id)))))
+ (obj-uri (unless (variable-p obj)
+ (when-do id (any-id (value obj) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (eql (reifier (value subj) :revision revision)
+ (value obj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (let ((reifier-top
+ (reifier (value subj) :revision revision)))
+ (when reifier-top
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (when-do id (any-id reifier-top :revision revision)
+ (embrace-uri (uri id)))))))
+ ((not (variable-p obj))
+ (let ((reified-cons
+ (reified-construct (value obj) :revision revision)))
+ (when reified-cons
+ (list (list :subject
+ (when-do id (any-id reified-cons :revision revision)
+ (embrace-uri (uri id)))
+ :predicate pred-uri
+ :object obj-uri)))))
+ (t ; only pred is given
+ (let ((topics
+ (remove-null
+ (map 'list #'(lambda(top)
+ (when (reified-construct top :revision revision)
+ top))
+ (get-all-topics revision)))))
+ (loop for top in topics
+ collect (list :subject
+ (when-do id (any-id (reified-construct
+ top :revision revision))
+ (embrace-uri (uri id)))
+ :predicate pred-uri
+ :object (when-do id (any-id top :revision revision)
+ (embrace-uri (uri id))))))))))))
\ No newline at end of file
1
0
Author: lgiessmann
Date: Tue Feb 1 12:55:25 2011
New Revision: 386
Log:
TM-SPARQL: added som function/methods that handles predicates for requesting: topicProperties, scopes, reifiers and values
Added:
trunk/src/TM-SPARQL/sparql_special_uris.lisp
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/isidorus.asd
trunk/src/model/datamodel.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Tue Feb 1 12:55:25 2011
@@ -15,6 +15,8 @@
:result
:init-tm-sparql))
+
+
(in-package :TM-SPARQL)
(defvar *empty-label* "_empty_label_symbol" "A label symobl for empyt prefix labels")
@@ -453,9 +455,11 @@
(declare (Integer revision))
(set-tm-constructs construct :revision revision)
(when (not (iri-not-found-p construct)) ;there is only a result if all IRIs were found
- (let ((results (or (filter-by-given-subject construct :revision revision)
- (filter-by-given-predicate construct :revision revision)
- (filter-by-given-object construct :revision revision))))
+ (let ((results (append
+ (or (filter-by-given-subject construct :revision revision)
+ (filter-by-given-predicate construct :revision revision)
+ (filter-by-given-object construct :revision revision))
+ (filter-by-special-uris construct :revision revision))))
(map 'list #'(lambda(result)
(push (getf result :subject) (subject-result construct))
(push (getf result :predicate) (predicate-result construct))
@@ -491,13 +495,9 @@
:revision revision))))))
-(defun filter-by-characteristic-value (literal-value literal-datatype
- &key (revision *TM-REVISION*))
- "Returns a triple where the passed value is a charvalue in a occurrence
- or name. The subject is the owner topic and the predicate is the
- characteristic's type."
- (declare (Integer revision)
- (String literal-datatype))
+(defun return-characteristics (literal-value literal-datatype)
+ "Returns all characteristica that own the specified value."
+ (declare (String literal-datatype))
(let ((chars
(cond ((string= literal-datatype *xml-string*)
(remove-if #'(lambda(elem)
@@ -506,30 +506,53 @@
(elephant:get-instances-by-value
'OccurrenceC 'charvalue literal-value)
(elephant:get-instances-by-value
+ 'VariantC 'charvalue literal-value)
+ (elephant:get-instances-by-value
'NameC 'charvalue literal-value))))
((and (string= literal-datatype *xml-boolean*)
literal-value)
(remove-if #'(lambda(elem)
(string/= (charvalue elem) "true"))
- (elephant:get-instances-by-value
- 'OccurrenceC 'charvalue "true")))
+ (append (elephant:get-instances-by-value
+ 'VariantC 'charvalue "true")
+ (elephant:get-instances-by-value
+ 'OccurrenceC 'charvalue "true"))))
((and (string= literal-datatype *xml-boolean*)
(not literal-value))
(remove-if #'(lambda(elem)
(string/= (charvalue elem) "false"))
- (elephant:get-instances-by-value
- 'OccurrenceC 'charvalue "false")))
+ (append (elephant:get-instances-by-value
+ 'VariantC 'charvalue "true")
+ (elephant:get-instances-by-value
+ 'OccurrenceC 'charvalue "false"))))
((or (string= literal-datatype *xml-double*)
(string= literal-datatype *xml-decimal*)
(string= literal-datatype *xml-integer*))
- (let ((occs
- (remove-if #'(lambda(occ)
- (string/= (datatype occ) literal-datatype))
- (elephant:get-instances-by-value
- 'OccurrenceC 'datatype literal-datatype))))
- (remove-if #'(lambda(occ)
- (not (literal= (charvalue occ) literal-value)))
- occs))))))
+ (let ((constructs
+ (remove-if #'(lambda(con)
+ (string/= (datatype con) literal-datatype))
+ (append
+ (elephant:get-instances-by-value
+ 'VariantC 'datatype literal-datatype)
+ (elephant:get-instances-by-value
+ 'OccurrenceC 'datatype literal-datatype)))))
+ (remove-if #'(lambda(con)
+ (not (literal= (charvalue con) literal-value)))
+ constructs))))))
+ ;;elephant returns names, occurences, and variants if any string
+ ;;value matches, so all duplicates have to be removed
+ (remove-duplicates chars)))
+
+
+(defun filter-by-characteristic-value (literal-value literal-datatype
+ &key (revision *TM-REVISION*))
+ "Returns a triple where the passed value is a charvalue in a occurrence
+ or name. The subject is the owner topic and the predicate is the
+ characteristic's type.
+ (Variants are not considered because they are not typed, so they cannot
+ be referenced via a predicate)."
+ (declare (Integer revision)
+ (String literal-datatype))
(remove-null
(map 'list #'(lambda(char)
(let ((subj (when-do top (parent char :revision revision)
@@ -540,13 +563,10 @@
(list :subject (embrace-uri subj)
:predicate (embrace-uri pred)
:object (charvalue char)
- :literal-datatyp literal-datatype))))
- ;;elephant returns names, occurences, and variants if any string
- ;;value matches, so all duplicates have to be removed, additionaly
- ;;variants have to be remove completely
- (remove-if #'(lambda(obj)
- (typep obj 'VariantC))
- (remove-duplicates chars))))))
+ :literal-datatype literal-datatype))))
+ (remove-if #'(lambda(char)
+ (typep char 'VariantC))
+ (return-characteristics literal-value literal-datatype)))))
(defgeneric filter-by-otherplayer (construct &key revision)
@@ -824,21 +844,37 @@
(funcall operator value-1 value-2))))
-(defun filter-occ-by-value (occurrence literal-value literal-datatype)
- "A helper that compares the occurrence's charvalue with the passed
+(defun filter-datatypable-by-value (construct literal-value literal-datatype)
+ "A helper that compares the datatypable's charvalue with the passed
literal value."
- (declare (OccurrenceC occurrence)
+ (declare (d::DatatypableC construct)
(type (or Null String) literal-value literal-datatype))
(when (or (not literal-datatype)
- (string= (datatype occurrence) literal-datatype))
+ (string= (datatype construct) literal-datatype))
(if (not literal-value)
- occurrence
+ construct
(handler-case
- (let ((occ-value (cast-literal (charvalue occurrence)
- (datatype occurrence))))
+ (let ((occ-value (cast-literal (charvalue construct)
+ (datatype construct))))
(when (literal= occ-value literal-value)
- occurrence))
+ construct))
(condition () nil)))))
+
+
+(defun filter-variant-by-value (variant literal-value literal-datatype)
+ "A helper that compares the occurrence's variant's with the passed
+ literal value."
+ (declare (VariantC variant)
+ (type (or Null String) literal-value literal-datatype))
+ (filter-datatypable-by-value variant literal-value literal-datatype))
+
+
+(defun filter-occ-by-value (occurrence literal-value literal-datatype)
+ "A helper that compares the occurrence's charvalue with the passed
+ literal value."
+ (declare (OccurrenceC occurrence)
+ (type (or Null String) literal-value literal-datatype))
+ (filter-datatypable-by-value occurrence literal-value literal-datatype))
(defgeneric filter-occurrences(construct type-top literal-value
Added: trunk/src/TM-SPARQL/sparql_special_uris.lisp
==============================================================================
--- (empty file)
+++ trunk/src/TM-SPARQL/sparql_special_uris.lisp Tue Feb 1 12:55:25 2011
@@ -0,0 +1,230 @@
+;;+-----------------------------------------------------------------------------
+;;+ Isidorus
+;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
+;;+
+;;+ Isidorus is freely distributable under the LLGPL license.
+;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
+;;+ trunk/docs/LGPL-LICENSE.txt.
+;;+-----------------------------------------------------------------------------
+
+
+(in-package :TM-SPARQL)
+
+
+;TODO: create a macro for "filter-for-scopes", "filter-for-reifier", ...
+;TODO: filter-by-special-uris
+;TODO: change (embrace-uri String) to (embrace-construct TopicMapsConstructC)
+; that creates a blank node when there is no identifier available
+; => change also any-id, so if there is no identifier a blank node
+; have to be returned
+; => change all when-do statements that call any-id
+
+
+
+
+(defgeneric filter-by-special-uris (construct &key revision)
+ (:documentation "Returns lists representing triples that handles special
+ predicate uris defined in tmsparql.")
+ (:method ((construct SPARQL-Triple) &key (revision d:*TM-REVISION*))
+ (let ((pred (predicate construct)))
+ (if (variable-p pred)
+ (filter-for-special-uris construct :revision revision)
+ (cond ((has-identifier (value pred) *tms-reifier*)
+ (filter-for-reifier construct :revision revision))
+ ((has-identifier (value pred) *tms-scope*)
+ (filter-for-special-uris construct :revision revision))
+ ((has-identifier (value pred) *tms-value*)
+ (filter-for-values construct :revision revision))
+ ((has-identifier (value pred) *tms-topicProperty*)
+ (filter-for-topicProperties construct :revision revision))
+ ((has-identifier (value pred) *tms-role*)
+ nil) ;TODO: implement
+ )))))
+
+
+(defgeneric filter-for-special-uris (construct &key revision)
+ (:documentation "Returns a list of triples representing the subject
+ and its objects correponding to the defined
+ special-uris, e.g. <subj> var <obj>.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ ;;TODO: implement
+ ;; *tms-reifier*
+ ;; *tms-scope*
+ ;; *tms-value* => only when there is <occ|var|nam> ? <LITERAL>, otherwise the predicate is the type of the characteristic
+ ;; *tms-topicProperty*
+ ))
+
+(defgeneric filter-for-topicProperties (construct &key revision)
+ (:documentation "Returns a list of triples where the subject represents
+ a topic and the object represents a name or occurrence.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ ;TODO: implement
+ ))
+
+
+(defgeneric filter-for-values (construct &key revision)
+ (:documentation "Returns a list of triples that represent a
+ subject and its literal value as object.")
+ (:method ((construct SPARQL-Triple) &key revision)
+ (declare (ignorable revision))
+ (when (or (literal-p (object construct))
+ (variable-p (object construct)))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (literal-datatype (literal-datatype obj))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (or (and (typep subj 'NameC)
+ (string= literal-datatype *xml-string*)
+ (string= (charvalue subj) obj))
+ (filter-datatypable-by-value subj obj literal-datatype))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj
+ :literal-datatype literal-datatype))))
+ ((not (variable-p subj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object (charvalue subj)
+ :literal-datatype (datatype subj))))
+ ((not (variable-p obj))
+ (loop for char in (return-characteristics obj literal-datatype)
+ collect (list :subject (when-do id (any-id char :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object (charvalue char)
+ :literal-datatype (datatype char))))
+ (t ;only pred is given
+ (let ((chars (append (get-all-names revision)
+ (get-all-occurrences revision)
+ (get-all-variants revision))))
+ (loop for char in chars
+ collect (list :subject (when-do id (any-id char :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object (charvalue char)
+ :literal-datatype (datatype char))))))))))
+
+
+(defgeneric filter-for-scopes (construct &key revision)
+ (:documentation "Returns a list of triples that represent a subject as the
+ scoped item and the object as the scope-topic.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (unless (literal-p (object construct))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id)))))
+ (obj-uri (unless (variable-p obj)
+ (when-do id (any-id (value obj) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (find obj (themes subj :revision revision))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (loop for scope in (themes subj :revision revision)
+ collect (list :subject subj-uri
+ :predicate pred-uri
+ :object (when-do id (any-id scope :revision revision)
+ (embrace-uri (uri id))))))
+ ((not (variable-p obj))
+ (let ((scoped-constructs
+ (used-as-theme (value obj) :revision revision)))
+ (loop for construct in scoped-constructs
+ collect (list :subject (when-do id (any-id construct :revision revision)
+ (embrace-uri (uri id)))
+ :predicate pred-uri
+ :object obj-uri))))
+ (t ;only pred is given
+ (let ((scoped-constructs
+ (remove-null
+ (map 'list #'(lambda(construct)
+ (when (themes construct :revision revision)
+ construct))
+ (append (get-all-associations revision)
+ (get-all-occurrences revision)
+ (get-all-names revision)
+ (get-all-variants))))))
+ (loop for construct in scoped-constructs
+ append (loop for scope in (themes construct :revision revision)
+ collect
+ (list :subject (when-do id (any-id construct
+ :revision revision)
+ (embrace-uri id))
+ :predicate pred-uri
+ :object (when-do id (any-id construct
+ :revision revision)
+ (embrace-uri id))))))))))))
+
+
+(defgeneric filter-for-reifier (construct &key revision)
+ (:documentation "Returns a list with one triple representing a reifier
+ and the corresponding reified construct.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (unless (literal-p (object construct))
+ (let* ((subj (subject construct))
+ (pred (predicate construct))
+ (obj (object construct))
+ (subj-uri (unless (variable-p subj)
+ (when-do id (any-id (value subj) :revision revision)
+ (embrace-uri (uri id)))))
+ (pred-uri (unless (variable-p pred)
+ (when-do id (any-id (value pred) :revision revision)
+ (embrace-uri (uri id)))))
+ (obj-uri (unless (variable-p obj)
+ (when-do id (any-id (value obj) :revision revision)
+ (embrace-uri (uri id))))))
+ (cond ((and (not (variable-p subj))
+ (not (variable-p obj)))
+ (when (eql (reifier (value subj) :revision revision)
+ (value obj))
+ (list (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ ((not (variable-p subj))
+ (let ((reifier-top
+ (reifier (value subj) :revision revision)))
+ (when reifier-top
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object (when-do id (any-id reifier-top :revision revision)
+ (embrace-uri (uri id)))))))
+ ((not (variable-p obj))
+ (let ((reified-cons
+ (reified-construct (value obj) :revision revision)))
+ (when reified-cons
+ (list (list :subject
+ (when-do id (any-id reified-cons :revision revision)
+ (embrace-uri (uri id)))
+ :predicate pred-uri
+ :object obj-uri)))))
+ (t ; only pred is given
+ (let ((topics
+ (remove-null
+ (map 'list #'(lambda(top)
+ (when (reified-construct top :revision revision)
+ top))
+ (get-all-topics revision)))))
+ (loop for top in topics
+ collect (list :subject
+ (when-do id (any-id (reified-construct
+ top :revision revision))
+ (embrace-uri (uri id)))
+ :predicate pred-uri
+ :object (when-do id (any-id top :revision revision)
+ (embrace-uri (uri id))))))))))))
\ No newline at end of file
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Tue Feb 1 12:55:25 2011
@@ -44,6 +44,8 @@
:components ((:file "sparql_constants")
(:file "sparql"
:depends-on ("sparql_constants"))
+ (:file "sparql_special_uris"
+ :depends-on ("sparql"))
(:file "filter_wrappers"
:depends-on ("sparql"))
(:file "sparql_filter"
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Tue Feb 1 12:55:25 2011
@@ -43,6 +43,7 @@
:FragmentC
;;methods, functions and macros
+ :has-identifier
:get-all-identifiers-of-construct
:xtm-id
:uri
@@ -153,6 +154,9 @@
:rec-remf
:get-all-topics
:get-all-associations
+ :get-all-occurrences
+ :get-all-names
+ :get-all-variants
:get-all-tms
;;globals
@@ -684,6 +688,18 @@
:function-symbol function-symbol))
+(defgeneric has-identifier (construct uri &key revision)
+ (:documentation "Returns an identifier if there is any identifier bound
+ to the passed construct with the specified uri.")
+ (:method ((construct TopicMapConstructC) (uri String)
+ &key (revision *TM-REVISION*))
+ (let ((all-ids
+ (get-all-identifiers-of-construct construct :revision revision)))
+ (find-if #'(lambda(idc)
+ (string= (uri idc) uri))
+ all-ids))))
+
+
(defgeneric get-most-recent-versioned-assoc (construct slot-symbol)
(:documentation "Returns the most recent VersionedAssociationC
object.")
@@ -747,6 +763,18 @@
(get-db-instances-by-class 'AssociationC :revision revision))
+(defun get-all-occurrences (&optional (revision *TM-REVISION*))
+ (get-db-instances-by-class 'OccurrenceC :revision revision))
+
+
+(defun get-all-names (&optional (revision *TM-REVISION*))
+ (get-db-instances-by-class 'NameC :revision revision))
+
+
+(defun get-all-variants (&optional (revision *TM-REVISION*))
+ (get-db-instances-by-class 'VariantC :revision revision))
+
+
(defun get-all-tms (&optional (revision *TM-REVISION*))
(get-db-instances-by-class 'TopicMapC :revision revision))
@@ -980,7 +1008,7 @@
(defgeneric check-for-duplicate-identifiers (construct &key revision)
(:documentation "Check for possibly duplicate identifiers and signal an
- duplicate-identifier-error is such duplicates are found"))
+ duplicate-identifier-error is such duplicates are found"))
(defgeneric get-all-identifiers-of-construct (construct &key revision)
1
0
Author: lgiessmann
Date: Tue Jan 25 12:46:43 2011
New Revision: 385
Log:
tm-sparql: added an xtm file that contains all special uris defined by the networkedplanet tmsparql proposal as topic with corresponding PSIs; added a funtion that allos to initialise the tmsparql module, ie. the tmsparql xtm is imported
Added:
trunk/src/TM-SPARQL/sparql_constants.lisp
trunk/src/TM-SPARQL/tmsparql_core_psis.xtm
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/isidorus.asd
trunk/src/xml-constants.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Tue Jan 25 12:46:43 2011
@@ -8,9 +8,12 @@
;;+-----------------------------------------------------------------------------
(defpackage :TM-SPARQL
- (:use :cl :datamodel :base-tools :exceptions :constants)
+ (:use :cl :datamodel :base-tools :exceptions :constants
+ :TM-SPARQL-Constants :xml-importer :xml-constants
+ :isidorus-threading :xml-tools)
(:export :SPARQL-Query
- :result))
+ :result
+ :init-tm-sparql))
(in-package :TM-SPARQL)
@@ -19,6 +22,30 @@
(defvar *equal-operators* nil "A Table taht contains tuples of
classes and equality operators.")
+
+(defun init-tm-sparql (&optional (revision (get-revision)))
+ "Imports the file tmsparql_core_psis.xtm. core_psis.xtm has to be imported
+ before."
+ (with-writer-lock
+ (with-tm (revision "tmsparql.xtm" (concat *tms* "topic-map"))
+ (let ((core-dom (cxml:parse-file *tmsparql_core_psis.xtm*
+ (cxml-dom:make-dom-builder)))
+ (xtm-id (reverse
+ (base-tools:string-until
+ (reverse
+ (pathname-name
+ xml-constants:*tmsparql_core_psis.xtm*)) "/"))))
+ (elephant:ensure-transaction (:txn-nosync t)
+ (loop for top-elem across
+ (xpath-child-elems-by-qname (dom:document-element core-dom)
+ *xtm2.0-ns* "topic")
+ do (let ((top
+ (from-topic-elem-to-stub top-elem revision
+ :xtm-id xtm-id)))
+ (add-to-tm xml-importer::tm top))))))))
+
+
+
(defun init-*equal-operators* ()
(setf *equal-operators*
(list (list :class 'Boolean :operator #'eql)
@@ -1164,8 +1191,5 @@
;; filters all entries that are not important for the result
;; => an intersection is invoked
(reduce-results construct (make-result-lists construct))
-; (dolist (triple (select-group construct))
-; (dolist (filter (filters construct))
-; (invoke-filter triple construct filter)))
(process-filters construct)
construct)
\ No newline at end of file
Added: trunk/src/TM-SPARQL/sparql_constants.lisp
==============================================================================
--- (empty file)
+++ trunk/src/TM-SPARQL/sparql_constants.lisp Tue Jan 25 12:46:43 2011
@@ -0,0 +1,35 @@
+;;+-----------------------------------------------------------------------------
+;;+ Isidorus
+;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
+;;+
+;;+ Isidorus is freely distributable under the LLGPL license.
+;;+ You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt and
+;;+ trunk/docs/LGPL-LICENSE.txt.
+;;+-----------------------------------------------------------------------------
+
+(defpackage :TM-SPARQL-Constants
+ (:use :cl :base-tools)
+ (:nicknames tms)
+ (:export :*tms*
+ :*tms-reifier*
+ :*tms-role*
+ :*tms-player*
+ :*tms-topicProperty*
+ :*tms-scope*
+ :*tms-value*))
+
+(in-package :TM-SPARQL-Constants)
+
+(defvar *tms* "http://www.networkedplanet.com/tmsparql/")
+
+(defvar *tms-reifier* (concat *tms* "reifier"))
+
+(defvar *tms-role* (concat *tms* "role"))
+
+(defvar *tms-player* (concat *tms* "player"))
+
+(defvar *tms-topicProperty* (concat *tms* "topicProperty"))
+
+(defvar *tms-scope* (concat *tms* "scope"))
+
+(defvar *tms-value* (concat *tms* "value"))
\ No newline at end of file
Added: trunk/src/TM-SPARQL/tmsparql_core_psis.xtm
==============================================================================
--- (empty file)
+++ trunk/src/TM-SPARQL/tmsparql_core_psis.xtm Tue Jan 25 12:46:43 2011
@@ -0,0 +1,45 @@
+<?xml version="1.0"?>
+<!-- ======================================================================= -->
+<!-- Isidorus -->
+<!-- (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff -->
+<!-- -->
+<!-- Isidorus is freely distributable under the LLGPL license. -->
+<!-- This ajax module uses the frameworks PrototypeJs and Scriptaculous, -->
+<!-- both are distributed under the MIT license. -->
+<!-- You can find a detailed description in trunk/docs/LLGPL-LICENSE.txt, -->
+<!-- trunk/docs/LGPL-LICENSE.txt and in -->
+<!-- trunk/src/ajax/javascripts/external/MIT-LICENSE.txt. -->
+<!-- ======================================================================= -->
+
+
+<!-- this file contains the special uri defined in tmsparql
+ (http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html)
+ as topic with only a psi as element corresponding to those defined in
+ tmsparql -->
+
+<topicMap xmlns="http://www.topicmaps.org/xtm/" version="2.0">
+ <topic id="reifier">
+ <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/reifier"/>
+ </topic>
+
+ <topic id="role">
+ <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/role"/>
+ </topic>
+
+ <topic id="player">
+ <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/player"/>
+ </topic>
+
+ <topic id="topicProperty">
+ <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/topicProperty"/>
+ </topic>
+
+ <topic id="scope">
+ <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/scope"/>
+ </topic>
+
+ <topic id="value">
+ <subjectIdentifier href="http://www.networkedplanet.com/tmsparql/value"/>
+ </topic>
+
+</topicMap>
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Tue Jan 25 12:46:43 2011
@@ -23,6 +23,7 @@
:depends-on ("base-tools"))
(:static-file "xml/xtm/core_psis.xtm")
(:static-file "xml/rdf/rdf_core_psis.xtm")
+ (:static-file "TM-SPARQL/tmsparql_core_psis.xtm")
(:file "xml-constants"
:depends-on ("xml/xtm/core_psis.xtm"
"constants"))
@@ -40,14 +41,21 @@
:depends-on ("exceptions")))
:depends-on ("constants" "base-tools"))
(:module "TM-SPARQL"
- :components ((:file "sparql")
+ :components ((:file "sparql_constants")
+ (:file "sparql"
+ :depends-on ("sparql_constants"))
(:file "filter_wrappers"
:depends-on ("sparql"))
(:file "sparql_filter"
:depends-on ("sparql" "filter_wrappers"))
(:file "sparql_parser"
:depends-on ("sparql" "sparql_filter")))
- :depends-on ("constants" "base-tools" "model"))
+ :depends-on ("constants"
+ "base-tools"
+ "model"
+ "xml-constants"
+ "xml"
+ "threading"))
(:module "xml"
:components ((:module "xtm"
:components ((:file "tools")
Modified: trunk/src/xml-constants.lisp
==============================================================================
--- trunk/src/xml-constants.lisp (original)
+++ trunk/src/xml-constants.lisp Tue Jan 25 12:46:43 2011
@@ -14,7 +14,8 @@
*isidorus-system*)
(:export :*xml-component*
:*core_psis.xtm*
- :*rdf_core_psis.xtm*))
+ :*rdf_core_psis.xtm*
+ :*tmsparql_core_psis.xtm*))
(in-package :xml-constants)
@@ -27,4 +28,8 @@
(defparameter *rdf_core_psis.xtm*
(asdf:component-pathname
- (asdf:find-component *isidorus-system* "xml/rdf/rdf_core_psis.xtm")))
\ No newline at end of file
+ (asdf:find-component *isidorus-system* "xml/rdf/rdf_core_psis.xtm")))
+
+(defparameter *tmsparql_core_psis.xtm*
+ (asdf:component-pathname
+ (asdf:find-component *isidorus-system* "TM-SPARQL/tmsparql_core_psis.xtm")))
\ No newline at end of file
1
0