[isidorus-cvs] r355 - in trunk/src: TM-SPARQL model
Lukas Giessmann
lgiessmann at common-lisp.net
Sat Nov 27 16:40:39 UTC 2010
Author: lgiessmann
Date: Sat Nov 27 11:40:38 2010
New Revision: 355
Log:
TM-SPARQL: fixed ticket #86 => requests without FILTERs can be processed
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_parser.lisp
trunk/src/model/datamodel.lisp
trunk/src/model/trivial-queries.lisp
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Sat Nov 27 11:40:38 2010
@@ -11,10 +11,33 @@
(:use :cl :datamodel :base-tools :exceptions :constants)
(:export :SPARQL-Query))
+;;TODO:
+;; *handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html
(in-package :TM-SPARQL)
-(defvar *empty-label* "_empty_label_symbol")
+(defvar *empty-label* "_empty_label_symbol" "A label symobl for empyt prefix labels")
+
+(defvar *equal-operators* nil "A Table taht contains tuples of
+ classes and equality operators.")
+
+(defun init-*equal-operators* ()
+ (setf *equal-operators*
+ (list (list :class 'Boolean :operator #'eql)
+ (list :class 'String :operator #'string=)
+ (list :class 'Number :operator #'=))))
+
+
+(init-*equal-operators*)
+
+
+(defun get-equal-operator (value)
+ (let ((entry
+ (find-if #'(lambda(entry)
+ (typep value (getf entry :class)))
+ *equal-operators*)))
+ (when entry
+ (getf entry :operator))))
(defclass SPARQL-Triple-Elem()
@@ -37,11 +60,12 @@
:initform nil
:type String
:documentation "Contains the @lang attribute of a literal")
- (literal-type :initarg :literal-type
- :accessor literal-type
- :type String
- :initform nil
- :documentation "Contains the datatype of the literal, e.g. xml:string"))
+ (literal-datatype :initarg :literal-datatype
+ :accessor literal-datatype
+ :type String
+ :initform nil
+ :documentation "Contains the datatype of the literal,
+ e.g. xml:string"))
(:documentation "Represents one element of an RDF-triple."))
@@ -195,36 +219,495 @@
(variables construct))))))
-
-
-;;TODO:
-;;
-;; find-triples (subject predicate object)
-;; * var var var => return the entire graph (all subjects)
-;; * var var object
-;; * var predicate var
-;; * var predicate object
-;; * subject var var
-;; * subject var object
-;; * subject predicate var
-;; * subject predicate object => return subject predicate object if true otherweise nil
-;; handle special URIs => http://www.networkedplanet.com/ontopic/2009/11/making_topic_maps_sparql.html
-
-(defgeneric set-result (construct)
+(defgeneric set-results (construct &key revision)
(:documentation "Calculates the result of a triple and set all the values in
the passed object.")
+ (:method ((construct SPARQL-Triple) &key (revision d:*TM-REVISION*))
+ (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))))
+ (map 'list #'(lambda(result)
+ (push (getf result :subject) (subject construct))
+ (push (getf result :predicate) (predicate construct))
+ (push (getf result :object) (object construct)))
+ ;;literal-datatype is not used and is not returned, since
+ ;;the values are returned as object of their specific type, e.g.
+ ;;integer, boolean, string, ...
+ results)))))
+
+
+(defgeneric filter-by-given-object (construct &key revision)
+ (:documentation "Returns a list representing a triple that is the result
+ of a given object.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (unless (variable-p (object construct))
+ (cond ((literal-p (object construct))
+ (filter-by-characteristic-value (value (object construct))
+ (literal-datatype (object construct))
+ :revision revision))
+ ((iri-p (object construct))
+ (filter-by-otherplayer (value (object construct))
+ :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-value literal-datatype))
+ (let ((chars
+ (cond ((string= literal-datatype *xml-string*)
+ (remove-if #'(lambda(elem)
+ (string/= (charvalue elem) literal-value))
+ (append
+ (elephant:get-instances-by-value
+ 'OccurrenceC 'charvalue literal-value)
+ (elephant:get-instances-by-value
+ 'NameC 'charvalue literal-value))))
+ ((and (string= literal-datatype *xml-boolean*)
+ (eql literal-value t))
+ (remove-if #'(lambda(elem)
+ (string/= (charvalue elem) "true"))
+ (elephant:get-instances-by-value
+ 'OccurrenceC 'charvalue "true")))
+ ((and (string= literal-datatype *xml-boolean*)
+ (eql literal-value nil))
+ (remove-if #'(lambda(elem)
+ (string/= (charvalue elem) "false"))
+ (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))))))
+ (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 subj
+ :predicate pred
+ :object (charvalue char)
+ :literal-datatyp literal-datatype))))
+ chars))))
+
+
+(defgeneric filter-by-otherplayer (construct &key revision)
+ (:documentation "Returns triples where the passed player is the object,
+ the other player is the subject and the type of the passed
+ player's role is the predicate.")
+ (: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)))
+ (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
+ (when-do plr (instance-of orole :revision revision)
+ (any-id plr :revision revision))))
+ (when (and obj-uri pred-uri subj-uri)
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ roles-by-oplayer)))))
+
+
+(defgeneric filter-by-given-predicate (construct &key revision)
+ (:documentation "Returns all topics that owns a characteristic of the
+ given type or an associaiton with an otherrole of the
+ given type. The result is a plist representing a triple.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (when (and (variable-p (subject construct))
+ (iri-p (predicate construct)))
+ (cond ((variable-p (object construct))
+ (append (filter-by-otherroletype construct :revision revision)
+ (filter-by-characteristictype construct :revision revision)))
+ ((literal-p (object construct))
+ (filter-by-characteristictype construct :revision revision))
+ ((iri-p (object construct))
+ (filter-by-otherroletype construct :revision revision))))))
+
+
+(defgeneric filter-by-otherroletype (construct &key revision)
+ (:documentation "Returns triple where the passed predicate is a
+ type of a role. The returned subject is the otherplayer,
+ the predicate is the passed predicate, the object is
+ the player of the role of the passed type.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (when (or (variable-p (object construct))
+ (iri-p (object construct)))
+ (let* ((roles-by-type
+ (map 'list #'(lambda(typed-construct)
+ (when (typep typed-construct 'RoleC)
+ typed-construct))
+ (used-as-type construct :revision revision)))
+ (roles-by-player
+ (if (iri-p (object construct))
+ (remove-null
+ (map 'list #'(lambda(role)
+ (when (eql (instance-of role :revision revision)
+ (value (object construct)))))
+ roles-by-type))
+ roles-by-type))
+ (pred-uri (any-id (value (predicate construct)) :revision revision)))
+ (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))
+ (orole (when (and assoc
+ (= (length
+ (roles assoc :revision revision))
+ 2))
+ (find-if #'(lambda(r)
+ (not (eql r role)))
+ (roles assoc :revision revision))))
+ (subj-uri
+ (when-do plr (player orole :revision revision)
+ (any-id plr :revision revision))))
+ (when (and subj-uri pred-uri obj-uri)
+ (list :subject subj-uri
+ :predicate pred-uri
+ :object obj-uri))))
+ roles-by-player))))))
+
+
+(defgeneric filter-by-characteristictype (construct &key revision)
+ (:documentation "Returns the results of filter-by-nametype and
+ filter-by-occurrencetype.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (append (filter-by-nametype construct :revision revision)
+ (filter-by-occurrencetype construct :revision revision))))
+
+
+(defgeneric filter-by-nametype (construct &key revision)
+ (:documentation "Returns all names that corresponds to the given parameters.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (when (and (not (iri-p (object construct)))
+ (or (not (literal-datatype construct))
+ (string= (literal-datatype construct) *xml-string*)))
+ (let* ((names-by-type
+ (remove-null
+ (map 'list #'(lambda(typed-construct)
+ (when (typep typed-construct 'NameC)
+ typed-construct))
+ (used-as-type (value (predicate construct))
+ :revision revision))))
+ (names-by-literal
+ (if (variable-p (object construct))
+ (remove-null
+ (map 'list #'(lambda(name)
+ (string= (charvalue name)
+ (value (object construct))))
+ names-by-type))
+ names-by-type)))
+ (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 subj
+ :predicate pred
+ :object (charvalue name)
+ :literal-datatype *xml-string*))))
+ names-by-literal))))))
+
+
+(defgeneric filter-by-occurrencetype (construct &key revision)
+ (:documentation "Returns all occurrence that corresponds to the
+ given parameters.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (unless (iri-p (object construct))
+ (let* ((occs-by-type
+ (remove-null
+ (map 'list #'(lambda(typed-construct)
+ (when (typep typed-construct 'OccurrenceC)
+ typed-construct))
+ (used-as-type (value (predicate construct))
+ :revision revision))))
+ (all-occs
+ (let ((literal-value (if (variable-p (object construct))
+ nil
+ (value (object construct))))
+ (literal-datatype (literal-datatype (object construct))))
+ (remove-null
+ (map 'list #'(lambda(occ)
+ (filter-occ-by-value occ literal-value
+ literal-datatype))
+ occs-by-type)))))
+ (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 subj
+ :predicate pred
+ :object (charvalue occ)
+ :literal-datatype (datatype occ)))))
+ all-occs))))))
+
+
+(defgeneric filter-by-given-subject (construct &key revision)
+ (:documentation "Calls filter-characteristics and filter associations
+ for the topic that is set as a subject of the passed triple.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (when (iri-p (subject construct))
+ (let* ((subj (value (subject construct)))
+ (pred (when (iri-p (predicate construct))
+ (value (predicate construct)))))
+ (cond ((variable-p (object construct))
+ (append (filter-characteristics
+ subj pred nil nil :revision revision)
+ (filter-associations
+ subj pred nil :revision revision)))
+ ((literal-p (object construct))
+ (filter-characteristics
+ subj pred (value (subject construct))
+ (literal-datatype (object construct)) :revision revision))
+ ((iri-p (object construct))
+ (filter-associations subj pred (value (object construct))
+ :revision revision)))))))
+
+
+(defgeneric literal-p (construct)
+ (:documentation "Returns t if the passed construct has an elem-type
+ set to 'LITERAL.")
+ (:method ((construct SPARQL-Triple-Elem))
+ (eql (elem-type construct) 'LITERAL)))
+
+
+(defgeneric iri-p (construct)
+ (:documentation "Returns t if the passed construct has an elem-type
+ set to 'IRI.")
+ (:method ((construct SPARQL-Triple-Elem))
+ (eql (elem-type construct) 'IRI)))
+
+
+(defgeneric variable-p (construct)
+ (:documentation "Returns t if the passed construct has an elem-type
+ set to 'VARIABLE.")
+ (:method ((construct SPARQL-Triple-Elem))
+ (eql (elem-type construct) 'VARIABLE)))
+
+
+(defgeneric iri-not-found-p (construct)
+ (:documentation "Must be called after a call of set-tm-constructs.
+ It returns t if a TM-construct was not found for a
+ given IRI, so the result value of a query is nil.")
(:method ((construct SPARQL-Triple))
- ;;TODO: implement
- construct))
-
-
-(defgeneric find-subject-var-var (construct)
- (:documentation "Finds a triple corresponding to the subject and sets
- both variables.")
- (:method ((construct SPARQL-Triple))
-
- ))
-
+ (or (iri-not-found-p (subject construct))
+ (iri-not-found-p (predicate construct))
+ (iri-not-found-p (object construct)))))
+
+
+(defmethod iri-not-found-p ((construct SPARQL-Triple-Elem))
+ (and (eql (elem-type construct) 'IRI)
+ (not (value construct))))
+
+
+(defgeneric set-tm-constructs (construct &key revision)
+ (:documentation "Calls the method set-tm-construct for every element
+ in a SPARQL-Triple object.")
+ (:method ((construct SPARQL-Triple) &key (revision *TM-REVISION*))
+ (when-do subj (subject construct)
+ (set-tm-construct subj :revision revision))
+ (when-do pred (predicate construct)
+ (set-tm-construct pred :revision revision))
+ (when-do obj (object construct) (set-tm-construct obj :revision revision))))
+
+
+(defgeneric set-tm-construct (construct &key revision)
+ (:documentation "Replaces the IRI in the given object by the corresponding
+ TM-construct.")
+ (:method ((construct SPARQL-Triple-Elem) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (when (eql (elem-type construct) 'IRI)
+ (setf (value construct)
+ (get-item-by-any-id (value construct) :revision revision)))))
+
+
+(defun literal= (value-1 value-2)
+ "Returns t if both arguments are equal. The equality function is searched in
+ the table *equal-operators*."
+ (when (or (and (numberp value-1) (numberp value-2))
+ (typep value-1 (type-of value-2))
+ (typep value-2 (type-of value-1)))
+ (let ((operator (get-equal-operator value-1)))
+ (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
+ literal value."
+ (declare (OccurrenceC occurrence)
+ (type (or Null String) literal-value literal-datatype))
+ (when (or (not literal-datatype)
+ (string= (datatype occurrence) literal-datatype))
+ (if (not literal-value)
+ occurrence
+ (handler-case
+ (let ((occ-value (cast-literal (charvalue occurrence)
+ (datatype occurrence))))
+ (when (literal= occ-value literal-value)
+ occurrence))
+ (condition () nil)))))
+
+
+(defgeneric filter-occurrences(construct type-top literal-value
+ literal-datatype &key revision)
+ (:documentation "Returns a list representing a triple.")
+ (:method ((construct TopicC) type-top literal-value literal-datatype
+ &key (revision *TM-REVISION*))
+ (declare (Integer revision)
+ (type (or Null String) literal-value literal-datatype)
+ (type (or Null TopicC) type-top))
+ (let* ((occs-by-type
+ (occurrences-by-type construct type-top :revision revision))
+ (all-occs
+ (remove-null
+ (map 'list
+ #'(lambda(occ)
+ (filter-occ-by-value occ literal-value literal-datatype))
+ occs-by-type)))
+ (subj-uri (any-id 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 subj-uri
+ :predicate pred-uri
+ :object (charvalue occ)
+ :literal-datatype (datatype occ)))))
+ all-occs)))))
+
+
+(defgeneric filter-names(construct type-top literal-value
+ &key revision)
+ (:documentation "Returns a list representing a triple.")
+ (:method ((construct TopicC) type-top literal-value
+ &key (revision *TM-REVISION*))
+ (declare (Integer revision)
+ (type (or Null String) literal-value)
+ (type (or Null TopicC) type-top))
+ (let* ((by-type
+ (names-by-type construct type-top :revision revision))
+ (by-literal (if literal-value
+ (names-by-value
+ construct #'(lambda(name)
+ (string= name literal-value))
+ :revision revision)
+ (names construct :revision revision)))
+ (all-names (intersection by-type by-literal))
+ (subj-uri (any-id 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 subj-uri
+ :predicate pred-uri
+ :object (charvalue name)
+ :literal-datatype *xml-string*))))
+ all-names)))))
+
+
+(defgeneric filter-characteristics (construct type-top literal-value
+ literal-datatype &key revision)
+ (:documentation "Returns a list representing a triple.")
+ (:method ((construct TopicC) type-top literal-value literal-datatype
+ &key (revision *TM-REVISION*))
+ (declare (Integer revision)
+ (type (or Null String) literal-value literal-datatype)
+ (type (or Null TopicC) type-top))
+ (let ((occs (filter-occurrences construct type-top literal-value
+ literal-datatype :revision revision))
+ (names (if (or (not literal-datatype)
+ (string= literal-datatype *xml-string*))
+ (filter-names construct type-top literal-value
+ :revision revision)
+ nil)))
+ (append occs names))))
+
+
+(defgeneric filter-associations(construct type-top player-top
+ &key revision)
+ (:documentation "Returns a list of the form (:type <uri> :value <uri>).
+ type-identifier is the type of the otherrole and
+ player-identifier if the otherplayer.")
+ (:method ((construct TopicC) type-top player-top
+ &key (revision *TM-REVISION*))
+ (declare (Integer revision)
+ (type (or Null TopicC) type-top player-top))
+ (let ((assocs
+ (associations-of construct nil nil type-top player-top
+ :revision revision)))
+ (remove-null ;only assocs with two roles can match!
+ (map 'list
+ #'(lambda(assoc)
+ (when (= (length (roles assoc :revision revision)) 2)
+ (let* ((other-role
+ (find-if #'(lambda(role)
+ (not (eql construct
+ (player role :revision revision))))
+ (roles assoc :revision revision)))
+ (pred-uri
+ (when-do type-top (instance-of other-role
+ :revision revision)
+ (any-id type-top :revision revision)))
+ (obj-uri
+ (when-do player-top (player other-role
+ :revision revision)
+ (any-id player-top :revision revision))))
+ (when (and pred-uri obj-uri)
+ (list :type pred-uri
+ :value obj-uri)))))
+ assocs)))))
(defmethod initialize-instance :after ((construct SPARQL-Query) &rest args)
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp Sat Nov 27 11:40:38 2010
@@ -92,7 +92,10 @@
next-query (original-query construct) "WHERE")))
(let* ((triples (string-after next-query "WHERE"))
(query-tail (parse-where construct triples)))
- (or query-tail) ;TODO: process tail-of query, e.g. order by, ...
+ (when (> (length query-tail) 0)
+ (error (make-sparql-parser-condition
+ query-tail (original-query construct)
+ "The end of the query. Solution sequence modifiers are not supported yet.")))
construct))))
@@ -147,7 +150,7 @@
(declare (String query-string)
(SPARQL-Query query-object))
;;TODO: implement
- (or query-string query-object))
+ )
(defun parse-triple-elem (query-string query-object &key (literal-allowed nil))
@@ -264,8 +267,12 @@
'sparql-parser-error
:message (format nil "Could not cast from ~a to ~a"
literal-value literal-type))))
- value))))
-
+ value))
+ (t
+ (error (make-condition
+ 'sparql-error
+ :message (format nil "The type \"~a\" is not supported."
+ literal-type))))))
(defun separate-literal-lang-or-type (query-string query-object)
"A helper function that returns (:next-query string :lang string
Modified: trunk/src/model/datamodel.lisp
==============================================================================
--- trunk/src/model/datamodel.lisp (original)
+++ trunk/src/model/datamodel.lisp Sat Nov 27 11:40:38 2010
@@ -43,6 +43,7 @@
:FragmentC
;;methods, functions and macros
+ :get-all-identifiers-of-construct
:xtm-id
:uri
:identified-construct
@@ -108,6 +109,8 @@
:get-item-by-item-identifier
:get-item-by-locator
:get-item-by-content
+ :get-item-by-any-id
+ :any-id
:string-integer-p
:with-revision
:get-latest-fragment-of-topic
@@ -170,6 +173,7 @@
:invoke-on
:names-by-type
:occurrences-by-type
+ :occurrences-by-datatype
:characteristics-by-type
:occurrences-by-value
:names-by-value
@@ -1028,6 +1032,11 @@
the TM."))
+(defgeneric any-id (construct &key revision)
+ (:documentation "Returns any uri of the constructs identifier, except
+ TopicIdentificationC. The order is: PSIs, SL, II."))
+
+
;;; generic functions/accessors ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; VersionInfocC
@@ -1838,6 +1847,28 @@
(item-identifiers construct :revision revision)))
+(defun get-item-by-any-id (id-uri &key (revision d:*TM-REVISION*))
+ "Returns a topic or REfifiableConstruct corresponding to the given uri."
+ (declare (String id-uri)
+ (Integer revision))
+ (or (d:get-item-by-psi id-uri :revision revision)
+ (get-item-by-item-identifier id-uri :revision revision)
+ (get-item-by-locator id-uri :revision revision)))
+
+
+(defmethod any-id ((construct TopicC) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (let ((psi (when-do psis (psis construct :revision revision)
+ (uri (first psis)))))
+ (if psi
+ psi
+ (let ((sl (when-do sls (locators construct :revision revision)
+ (uri (first sls)))))
+ (if sl
+ sl
+ (call-next-method))))))
+
+
(defgeneric names (construct &key revision)
(:documentation "Returns the NameC-objects that correspond
with the passed construct and the passed version.")
@@ -3159,7 +3190,6 @@
construct 'reifier :start-revision revision)))
(when assocs ;assocs must be nil or a list with exactly one item
(reifier-topic (first assocs))))))
-1
(defgeneric add-item-identifier (construct item-identifier &key revision)
@@ -3229,6 +3259,12 @@
construct)))
+(defmethod any-id ((construct ReifiableConstructC) &key (revision *TM-REVISION*))
+ (declare (Integer revision))
+ (when-do iis (item-identifiers construct :revision revision)
+ (uri (first iis))))
+
+
(defgeneric add-reifier (construct reifier-topic &key revision)
(:documentation "Adds the passed reifier-topic as reifier of the construct.
If the construct is already reified by the given topic
Modified: trunk/src/model/trivial-queries.lisp
==============================================================================
--- trunk/src/model/trivial-queries.lisp (original)
+++ trunk/src/model/trivial-queries.lisp Sat Nov 27 11:40:38 2010
@@ -321,6 +321,20 @@
(occurrences-by-value construct filter :revision revision))))
+(defgeneric occurrences-by-datatype (construct datatype &key revision)
+ (:documentation "Returns all occurrences of the specified datatype.")
+ (:method ((construct TopicC) datatype &key (revision *TM-REVISION*))
+ (declare (type (or Null String) datatype)
+ (Integer revision))
+ (if datatype
+ (remove-null
+ (map 'list #'(lambda(occ)
+ (when (string= (datatype occ) datatype)
+ occ))
+ (occurrences construct :revision revision)))
+ (occurrences construct :revision revision))))
+
+
(defgeneric isa (construct type &key revision)
(:documentation "Returns all types if the passed construct
is of the specified type.")
More information about the Isidorus-cvs
mailing list