[isidorus-cvs] r393 - trunk/src/TM-SPARQL
Lukas Giessmann
lgiessmann at common-lisp.net
Tue Feb 8 14:58:11 UTC 2011
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
More information about the Isidorus-cvs
mailing list