November 2010 - isidorus-cvs@common-lisp.net

[isidorus-cvs] r336 - in trunk/src: . TM-SPARQL unit_tests
by Lukas Giessmann 10 Nov '10

10 Nov '10

Author: lgiessmann Date: Wed Nov 10 03:32:07 2010 New Revision: 336 Log: added the fundamental module-structure including all files for the TM-SPARQL-interface and the corresponding unit-tests Added: trunk/src/TM-SPARQL/ trunk/src/TM-SPARQL/sparql.lisp trunk/src/TM-SPARQL/sparql_tokenizer.lisp trunk/src/unit_tests/sparql_test.lisp trunk/src/unit_tests/trivial_queries_test.lisp Modified: trunk/src/isidorus.asd Added: trunk/src/TM-SPARQL/sparql.lisp ============================================================================== --- (empty file) +++ trunk/src/TM-SPARQL/sparql.lisp Wed Nov 10 03:32:07 2010 @@ -0,0 +1,10 @@ +;;+----------------------------------------------------------------------------- +;;+ 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) Added: trunk/src/TM-SPARQL/sparql_tokenizer.lisp ============================================================================== --- (empty file) +++ trunk/src/TM-SPARQL/sparql_tokenizer.lisp Wed Nov 10 03:32:07 2010 @@ -0,0 +1,14 @@ +;;+----------------------------------------------------------------------------- +;;+ 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 + (:use :cl :datamodel)) + + +(in-package :TM-SPARQL) Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Wed Nov 10 03:32:07 2010 @@ -40,6 +40,11 @@ (:file "model_tools" :depends-on ("exceptions"))) :depends-on ("constants")) + (:module "TM-SPARQL" + :components ((:file "sparql" + :depends-on ("sparql_tokenizer")) + (:file "sparql_tokenizer")) + :depends-on ("constants" "base-tools" "model")) (:module "xml" :components ((:module "xtm" :components ((:file "tools") @@ -161,6 +166,10 @@ :depends-on ("fixtures")) (:file "datamodel_test" :depends-on ("fixtures")) + (:file "sparql_test" + :depends-on ("fixtures")) + (:file "trivial_queries_test" + :depends-on ("fixtures")) (:file "reification_test" :depends-on ("fixtures" "unittests-constants"))) :depends-on ("atom" Added: trunk/src/unit_tests/sparql_test.lisp ============================================================================== --- (empty file) +++ trunk/src/unit_tests/sparql_test.lisp Wed Nov 10 03:32:07 2010 @@ -0,0 +1,28 @@ +;;+----------------------------------------------------------------------------- +;;+ 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 :sparql-test + (:use :cl + :it.bese.FiveAM + :TM-SPARQL) + (:export :run-sparql-tests + :sparql-tests)) + + +(in-package :sparql-test) + + +(def-suite sparql-test + :description "tests various key functions of the TM-SPARQL module") + +(in-suite sparql-test) + + +(defun run-sparql-tests () + (it.bese.fiveam:run! 'sparql-test:sparql-tests)) \ No newline at end of file Added: trunk/src/unit_tests/trivial_queries_test.lisp ============================================================================== --- (empty file) +++ trunk/src/unit_tests/trivial_queries_test.lisp Wed Nov 10 03:32:07 2010 @@ -0,0 +1,29 @@ +;;+----------------------------------------------------------------------------- +;;+ 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 :trivial-queries-test + (:use :cl + :it.bese.FiveAM + :datamodel) + (:export :run-trivial-queries-tests + :trivial-queries-tests)) + + +(in-package :trivial-queries-test) + + +(def-suite trivial-queries-test + :description "tests various key functions of the trivial-query-test of + the datamodel module") + +(in-suite trivial-queries-test) + + +(defun run-trivial-queries-tests () + (it.bese.fiveam:run! 'trivial-queries-test:trivial-queries-tests)) \ No newline at end of file

1 0

[isidorus-cvs] r335 - trunk/src/model
by Lukas Giessmann 09 Nov '10

09 Nov '10

Author: lgiessmann Date: Tue Nov 9 15:52:19 2010 New Revision: 335 Log: changed the function invoke-on, so an additional cast-operation can't be passed, since the casting can be done in the main-operation directly; added the functions: names-by-type, names-by-value, occurrences-by-type, occurrences-by-value, characterisitcs-by-type, characterisitcs-by-value; added the condition bad-type-error Modified: trunk/src/model/datamodel.lisp trunk/src/model/exceptions.lisp trunk/src/model/trivial-queries.lisp Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue Nov 9 15:52:19 2010 @@ -15,7 +15,8 @@ object-not-found-error missing-argument-error not-mergable-error - tm-reference-error) + tm-reference-error + bad-type-error) (:import-from :constants *xml-string* *instance-psi*) @@ -167,7 +168,13 @@ :direct-supertypes :supertypes :direct-instance-of - :invoke-on)) + :invoke-on + :names-by-type + :occurrencs-by-type + :characteristics-by-type + :occurrences-by-value + :names-by-value + :characteristics-by-value)) (in-package :datamodel) @@ -648,6 +655,14 @@ :new-reference new-reference)) +(defun make-bad-type-condition (message expected-type result-object) + (make-condition + 'bad-type-error + :message message + :expected-type expected-type + :result-object result-object)) + + (defun make-not-mergable-condition (message construct-1 construct-2) "Returns a not-mergable-condition with the passed arguments." (make-condition 'not-mergable-error Modified: trunk/src/model/exceptions.lisp ============================================================================== --- trunk/src/model/exceptions.lisp (original) +++ trunk/src/model/exceptions.lisp Tue Nov 9 15:52:19 2010 @@ -16,7 +16,8 @@ :object-not-found-error :not-mergable-error :missing-argument-error - :tm-reference-error)) + :tm-reference-error + :bad-type-error)) (in-package :exceptions) @@ -103,6 +104,20 @@ (new-reference :initarg :new-reference :accessor new-reference)) - (:documentation "Thrown of the referenced-construct is already owned by another + (:documentation "Thrown if the referenced-construct is already owned by another TM-construct (existing-reference) and is going to be referenced - by a second TM-construct (new-reference) at the same time.")) \ No newline at end of file + by a second TM-construct (new-reference) at the same time.")) + + +(define-condition bad-type-error (error) + ((message + :initarg :message + :accessor message) + (expected-type + :initarg :expected-type + :accessor expected-type) + (result-object + :initarg :result-object + :accessor result-object)) + (:documentation "Thrown if a bad result object with respect to the expected + type was found.")) \ No newline at end of file Modified: trunk/src/model/trivial-queries.lisp ============================================================================== --- trunk/src/model/trivial-queries.lisp (original) +++ trunk/src/model/trivial-queries.lisp Tue Nov 9 15:52:19 2010 @@ -225,15 +225,88 @@ (remove-if #'null all-types))))) -(defgeneric invoke-on (construct main-operation &key cast-operation) +(defgeneric invoke-on (construct operation) (:documentation "Invokes the passed main operation on the characteristic's value. If cast-operation is set to a function the characteristic's value is first casted by the cast-operation to another type and afterwords processed by main-opertion.") - (:method ((construct TopicC) (main-operation Function) &key cast-operation) - (declare (type (or Null Function) cast-operation)) - (let ((value (if cast-operation - (apply cast-operation (list (charvalue construct))) - (charvalue construct)))) - (funcall main-operation value)))) \ No newline at end of file + (:method ((construct TopicC) (operation Function)) + (funcall operation (charvalue construct)))) + + +(defgeneric names-by-type (construct type-identifier &key revision) + (:documentation "Returns all names that are of the corresponding type.") + (:method ((construct TopicC) (type-identifier IdentifierC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((type-topic (identified-construct type-identifier :revision revision))) + (unless (typep type-topic 'TopicC) + (error (make-bad-type-condition (format nil "from name-by-type(): expected a topic as instance-of but found ~a" (type-of type-topic)) 'TopicC type-topic))) + (let ((results + (map 'list #'(lambda(name) + (when (instance-of name :revision revision) + name)) + (names construct :revision revision)))) + (remove-if #'null results))))) + + +(defgeneric occurrences-by-type (construct type-identifier &key revision) + (:documentation "Returns all names that are of the corresponding type.") + (:method ((construct TopicC) (type-identifier IdentifierC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((type-topic (identified-construct type-identifier :revision revision))) + (unless (typep type-topic 'TopicC) + (error (make-bad-type-condition (format nil "from occurrence-by-type(): expected a topic as instance-of but found ~a" (type-of type-topic)) 'TopicC type-topic))) + (let ((results + (map 'list #'(lambda(occ) + (when (instance-of occ :revision revision) + occ)) + (occurrences construct :revision revision)))) + (remove-if #'null results))))) + + +(defgeneric characteristic-by-type (construct type-identifier &key revision) + (:documentation "Returns all characteristics that are of the + corresponding type.") + (:method ((construct TopicC) (type-identifier IdentifierC) + &key (revision *TM-REVISION*)) + (declare (integer revision)) + (union (names-by-type construct type-identifier :revision revision) + (occurrences-by-type construct type-identifier :revision revision)))) + + +(defgeneric occurrences-by-value (construct filter &key revision) + (:documentation "Returns a list of all occurrences of the passed + topic, that return a true value when calling filter + on their charvalue.") + (:method ((construct TopicC) (filter Function) &key (revision *TM-REVISION*)) + (let ((results + (map 'list #'(lambda(occ) + (when (invoke-on occ filter) + occ)) + (occurrences construct :revision revision)))) + (remove-if #'null results)))) + + +(defgeneric names-by-value (construct filter &key revision) + (:documentation "Returns a list of all names of the passed + topic, that return a true value when calling filter + on their charvalue.") + (:method ((construct TopicC) (filter Function) &key (revision *TM-REVISION*)) + (let ((results + (map 'list #'(lambda(name) + (when (invoke-on name filter) + name)) + (names construct :revision revision)))) + (remove-if #'null results)))) + + +(defgeneric characteristic-by-value (construct filter &key revision) + (:documentation "Returns a list of all characteristics of the passed + topic, that return a true value when calling filter.") + (:method ((construct TopicC) (filter Function) &key (revision *TM-REVISION*)) + (declare (integer revision)) + (union (names-by-value construct filter :revision revision) + (occurrences-by-value construct filter :revision revision)))) \ No newline at end of file

1 0

[isidorus-cvs] r334 - in trunk/src: . base-tools model xml/rdf xml/xtm
by Lukas Giessmann 09 Nov '10

09 Nov '10

Author: lgiessmann Date: Tue Nov 9 15:00:20 2010 New Revision: 334 Log: added the file trivial-queries.lisp => currently it contains trivial query functions for roles and associations and an invoke-on method for characteristics that invokes a method with the characteristics value as parameter, additionally a cast-operation can be passed to cast the string-value to a certain type, e.g. integer. Added: trunk/src/base-tools/ trunk/src/base-tools/base-tools.lisp trunk/src/model/trivial-queries.lisp Modified: trunk/src/isidorus.asd trunk/src/model/datamodel.lisp trunk/src/xml/rdf/rdf_tools.lisp trunk/src/xml/xtm/tools.lisp Added: trunk/src/base-tools/base-tools.lisp ============================================================================== --- (empty file) +++ trunk/src/base-tools/base-tools.lisp Tue Nov 9 15:00:20 2010 @@ -0,0 +1,33 @@ +;;+----------------------------------------------------------------------------- +;;+ 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 :base-tools + (:use :cl) + (:nicknames :tools) + (:export :push-string + :when-do)) + +(in-package :base-tools) + + +(defmacro push-string (obj place) + "Imitates the push macro but instead of pushing object in a list, + there will be appended the given string to the main string object." + `(setf ,place (concatenate 'string ,place ,obj))) + + +(defmacro when-do (result-bounding condition-statement do-with-result) + "Executes the first statement and stores its result in the variable result. + If result isn't nil the second statement is called. + The second statement can use the variable tools:result as a parameter." + `(let ((,result-bounding ,condition-statement)) + (if ,result-bounding + ,do-with-result + nil))) + Modified: trunk/src/isidorus.asd ============================================================================== --- trunk/src/isidorus.asd (original) +++ trunk/src/isidorus.asd Tue Nov 9 15:00:20 2010 @@ -27,12 +27,16 @@ (:file "xml-constants" :depends-on ("xml/xtm/core_psis.xtm" "constants")) + (:module "base-tools" + :components ((:file "base-tools"))) (:module "model" :components ((:file "exceptions") (:file "datamodel" :depends-on ("exceptions")) + (:file "trivial-queries" + :depends-on ("datamodel")) (:file "changes" - :depends-on ("datamodel")) + :depends-on ("datamodel" "trivial-queries")) (:file "model_tools" :depends-on ("exceptions"))) :depends-on ("constants")) @@ -65,7 +69,8 @@ :depends-on ("constants" "xml-constants" "model" - "threading")) + "threading" + "base-tools")) (:module "atom" :components ((:file "atom") ;; (:file "configuration" Modified: trunk/src/model/datamodel.lisp ============================================================================== --- trunk/src/model/datamodel.lisp (original) +++ trunk/src/model/datamodel.lisp Tue Nov 9 15:00:20 2010 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :datamodel - (:use :cl :elephant :constants) + (:use :cl :elephant :constants :base-tools) (:nicknames :d) (:import-from :exceptions duplicate-identifier-error @@ -152,10 +152,22 @@ :get-all-associations :get-all-tms - ;;globals :*TM-REVISION* - :*CURRENT-XTM*)) + :*CURRENT-XTM* + + ;;trivial-queries + :roles-by-type + :roles-by-player + :filter-associations-by-type + :filter-associations-by-role + :associations-of + :instance-of-associations + :supertype-associations + :direct-supertypes + :supertypes + :direct-instance-of + :invoke-on)) (in-package :datamodel) Added: trunk/src/model/trivial-queries.lisp ============================================================================== --- (empty file) +++ trunk/src/model/trivial-queries.lisp Tue Nov 9 15:00:20 2010 @@ -0,0 +1,239 @@ +;;+----------------------------------------------------------------------------- +;;+ 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 :datamodel) + + +(defgeneric roles-by-type (construct role-type &key revision) + (:documentation "Returns all roles of the passed topic or + association that is of the specified role-type. + If role-type is set to nil all roles are returned.")) + + +(defmethod roles-by-type ((construct TopicC) role-type &key (revision *TM-REVISION*)) + (declare (integer revision) + (type (or Null TopicC) role-type)) + (if role-type + (remove-if #'null + (map 'list #'(lambda(role) + (when (eql (instance-of role :revision revision) + role-type) + role)) + (player-in-roles construct :revision revision))) + (player-in-roles construct :revision revision))) + + +(defmethod roles-by-type ((construct AssociationC) role-type + &key (revision *TM-REVISION*)) + (declare (integer revision) + (type (or Null TopicC) role-type)) + (if role-type + (remove-if #'null + (map 'list #'(lambda(role) + (when (eql (instance-of role :revision revision) + role-type) + role)) + (roles construct :revision revision))) + (roles construct :revision revision))) + + +(defgeneric roles-by-player (construct role-player &key revision) + (:documentation "Returns all roles that contains the corresponding player. + If the player is set to nil all roles are returned.") + (:method ((construct AssociationC) role-player &key (revision *TM-REVISION*)) + (declare (integer revision) + (type (or Null TopicC) role-player)) + (if role-player + (remove-if #'null + (map 'list #'(lambda(role) + (when (eql (player role :revision revision) + role-player) + role)) + (roles construct :revision revision))) + (roles construct :revision revision)))) + + +(defun filter-associations-by-type (associations association-type + &key (revision *TM-REVISION*)) + "Returns a list of associations that are an instance-of of the given + association-type. If association-type is set to nil, all associations + are returned." + (declare (List associations) + (type (or Null TopicC) association-type) + (integer revision)) + (if association-type + (remove-if #'(lambda(assoc) + (not (eql (instance-of assoc :revision revision) + association-type))) + associations) + associations)) + + +(defun filter-associations-by-role (associations role-type role-player + &key (revision *TM-REVISION*)) + "Returns associations that have a role corresponding to the passed + values. If any of the passed role-values is set to nil, it won't be used + for the evaluation of the result." + (declare (List associations) + (type (or Null TopicC) role-type role-player)) + (remove-if #'null + (intersection + (map 'list #'(lambda(assoc) + (when (roles-by-type assoc role-type + :revision revision) + assoc)) + associations) + (map 'list #'(lambda(assoc) + (when (roles-by-player assoc role-player + :revision revision) + assoc)) + associations)))) + + +(defgeneric associations-of (construct role-type association-type + other-role-type other-player + &key revision) + (:documentation "Returns all associations of the passed topic (construct) + that corresponds to the given values. + If any of the passed values is set to nil, it won't be + used to evaluate the result.") + (:method ((construct TopicC) role-type association-type other-role-type + other-player &key (revision *TM-REVISION*)) + (declare (integer revision) + (type (or Null TopicC) role-type association-type + other-role-type other-player)) + (let ((assocs-by-role (map 'list #'(lambda(role) + (parent role :revision revision)) + (roles-by-type construct role-type + :revision revision)))) + (let ((assocs-by-type + (filter-associations-by-type assocs-by-role association-type + :revision revision))) + (filter-associations-by-role assocs-by-type other-role-type + other-player :revision revision))))) + + +(defgeneric instance-of-associations (construct &key revision) + (:documentation "Returns all type-instance associations of + the passed instance topic.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((type-top + (get-item-by-psi *type-psi* :revision revision :error-if-nil t)) + (instance-top + (get-item-by-psi *instance-psi* :revision revision :error-if-nil t)) + (type-instance-top + (get-item-by-psi *type-instance-psi* :revision revision + :error-if-nil t))) + (let ((possible-assocs + (map 'list #'(lambda(role) + (parent role :revision revision)) + (roles-by-type construct instance-top :revision revision)))) + (let ((type-instance-assocs + (filter-associations-by-type possible-assocs type-instance-top + :revision revision))) + (filter-associations-by-role type-instance-assocs type-top nil + :revision revision)))))) + + +(defgeneric supertype-associations (construct &key revision) + (:documentation "Returns all supertype-subtype associations of + the passed subtype topic.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((supertype-top + (get-item-by-psi *supertype-psi* :revision revision :error-if-nil t)) + (subtype-top + (get-item-by-psi *subtype-psi* :revision revision :error-if-nil t)) + (supertype-subtype-top + (get-item-by-psi *supertype-subtype-psi* :revision revision + :error-if-nil t))) + (let ((possible-assocs + (map 'list #'(lambda(role) + (parent role :revision revision)) + (roles-by-type construct subtype-top :revision revision)))) + (let ((type-instance-assocs + (filter-associations-by-type possible-assocs supertype-subtype-top + :revision revision))) + (filter-associations-by-role type-instance-assocs supertype-top nil + :revision revision)))))) + + +(defgeneric direct-supertypes (construct &key revision) + (:documentation "Returns all direct super type topics of the passed + construct.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((assocs (supertype-associations construct :revision revision))) + (remove-if #'null + (map 'list #'(lambda(assoc) + (find-if-not + #'(lambda(role) + (eql (player role :revision revision) + construct)) + (roles assoc :revision revision))) + assocs))))) + + +(defgeneric supertypes (construct &key revision valid-supertypes) + (:documentation "Returns all super type topics of the passed + construct, also the transitive ones.") + (:method ((construct TopicC) &key (revision *TM-REVISION*) valid-supertypes) + (declare (integer revision)) + (let ((direct-super-types (direct-supertypes construct :revision revision))) + (let ((current-valid-super-types + (append valid-supertypes direct-super-types))) + (let ((recursive-super-types + (loop for direct-super-type in direct-super-types + append (supertypes + direct-super-type :revision revision + :valid-supertypes current-valid-super-types)))) + (remove-duplicates + (remove-if #'null recursive-super-types))))))) + + +(defgeneric direct-instance-of (construct &key revision) + (:documentation "Returns all direct type topics of the passed instance topic.") + (:method ((construct TopicC) &key (revision *TM-REVISION*)) + (declare (integer revision)) + (let ((assocs (instance-of-associations construct :revision revision))) + (remove-if #'null + (map 'list #'(lambda(assoc) + (find-if-not + #'(lambda(role) + (eql (player role :revision revision) + construct)) + (roles assoc :revision revision))) + assocs))))) + + +(defmethod instance-of (construct &key (revision *TM-REVISION*)) + "Returns all type topics of the passed construct and their super-types." + (declare (integer revision)) + (let ((all-super-types (supertypes construct :revision revision))) + (let ((all-types + (loop for topic in (append (list construct) all-super-types) + append (direct-instance-of topic :revision revision)))) + (remove-duplicates + (remove-if #'null all-types))))) + + +(defgeneric invoke-on (construct main-operation &key cast-operation) + (:documentation "Invokes the passed main operation on the characteristic's + value. + If cast-operation is set to a function the characteristic's + value is first casted by the cast-operation to another type + and afterwords processed by main-opertion.") + (:method ((construct TopicC) (main-operation Function) &key cast-operation) + (declare (type (or Null Function) cast-operation)) + (let ((value (if cast-operation + (apply cast-operation (list (charvalue construct))) + (charvalue construct)))) + (funcall main-operation value)))) \ No newline at end of file Modified: trunk/src/xml/rdf/rdf_tools.lisp ============================================================================== --- trunk/src/xml/rdf/rdf_tools.lisp (original) +++ trunk/src/xml/rdf/rdf_tools.lisp Tue Nov 9 15:00:20 2010 @@ -8,7 +8,8 @@ ;;+----------------------------------------------------------------------------- (defpackage :rdf-importer - (:use :cl :cxml :elephant :datamodel :isidorus-threading :datamodel) + (:use :cl :cxml :elephant :datamodel :isidorus-threading :datamodel + :base-tools) (:import-from :constants *rdf-ns* *rdfs-ns* @@ -78,7 +79,6 @@ absolutize-value absolutize-id concatenate-uri - push-string node-to-string) (:import-from :xml-importer get-uuid Modified: trunk/src/xml/xtm/tools.lisp ============================================================================== --- trunk/src/xml/xtm/tools.lisp (original) +++ trunk/src/xml/xtm/tools.lisp Tue Nov 9 15:00:20 2010 @@ -8,7 +8,7 @@ ;;+----------------------------------------------------------------------------- (defpackage :xml-tools - (:use :cl :cxml) + (:use :cl :cxml :base-tools) (:import-from :constants *xml-ns* *xmlns-ns* @@ -29,17 +29,10 @@ :absolutize-value :absolutize-id :concatenate-uri - :push-string :node-to-string)) (in-package :xml-tools) -(defmacro push-string (obj place) - "Imitates the push macro but instead of pushing object in a list, - there will be appended the given string to the main string object." - `(setf ,place (concatenate 'string ,place ,obj))) - - (defun concatenate-uri (absolute-ns value) "Returns a string conctenated of the absolut namespace an the given value separated by either '#' or '/'."

1 0