[isidorus-cvs] r419 - in trunk/src: TM-SPARQL base-tools unit_tests
Lukas Giessmann
lgiessmann at common-lisp.net
Wed Apr 6 15:02:36 UTC 2011
Author: lgiessmann
Date: Wed Apr 6 11:02:36 2011
New Revision: 419
Log:
TM-SPARQL: sparql filters now support constants of the form 'string-value'^^datatype and 'string'@lang
Modified:
trunk/src/TM-SPARQL/filter_wrappers.lisp
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_filter.lisp
trunk/src/base-tools/base-tools.lisp
trunk/src/unit_tests/sparql_test.lisp
Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp
==============================================================================
--- trunk/src/TM-SPARQL/filter_wrappers.lisp (original)
+++ trunk/src/TM-SPARQL/filter_wrappers.lisp Wed Apr 6 11:02:36 2011
@@ -177,7 +177,7 @@
(cond (type-suffix type-suffix)
((integerp x) constants::*xml-integer*)
((floatp x) constants::*xml-decimal*)
- ((numberp x) constants::*xml-double*)
+ ((typep x 'double-float) constants::*xml-double*)
((stringp x) constants::*xml-string*)
(t (type-of x)))))
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Wed Apr 6 11:02:36 2011
@@ -426,20 +426,17 @@
(cast-variable-values construct filter-variable-values))
(dolist (filter (filters construct))
(dolist (var-elem filter-variable-values)
-
- ;(format t "~a~%==>~a~%~%" (to-lisp-code var-elem filter)
- ;(eval (read-from-string (to-lisp-code var-elem filter)))) ;TODO: remove
+
+ ;(format t "~%~%>>~a<<~%~%" (to-lisp-code var-elem filter)); TODO: remove
(when (eval (read-from-string (to-lisp-code var-elem filter)))
(map 'list #'(lambda(list-elem)
(push list-elem true-values))
var-elem))))
- ;(format t "tv: -->~a<--~%" true-values) ;TODO: remove
(let ((values-to-remove
(return-false-values filter-variable-values
(remove-duplicates true-values
:test #'variable-list=))))
- ;(format t "vr: -->~a<--~%" values-to-remove) ;TODO: remove
(dolist (to-del values-to-remove)
(delete-rows-by-value construct (getf to-del :variable-name)
(getf to-del :variable-value))))))
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp Wed Apr 6 11:02:36 2011
@@ -106,8 +106,10 @@
(original-filter-string
(subseq query-string 0 (- (length query-string)
(length next-query))))
+ (filter-string-casted-constants
+ (cast-literal-constants construct filter-string))
(filter-string-unary-ops
- (set-unary-operators construct filter-string))
+ (set-unary-operators construct filter-string-casted-constants))
(filter-string-or-and-ops
(set-or-and-operators construct filter-string-unary-ops
original-filter-string))
@@ -119,10 +121,57 @@
(set-functions construct filter-string-compare-ops)))
(add-filter construct
(scan-filter-for-deprecated-calls
- construct filter-string-functions original-filter-string))
+ construct filter-string-functions filter-string))
(parse-group construct next-query))))
+(defgeneric cast-literal-constants (construct filter-string)
+ (:documentation "Casts all constants of the form 'string-value'^^datatype to an
+ object of the specified type. If the specified type is not
+ supported the return value is the string-value without a
+ type specifier.")
+ (:method ((construct SPARQL-Query) (filter-string String))
+ (let ((first-pos (search-first (list "'" "\"") filter-string)))
+ (if (not first-pos)
+ filter-string
+ (let* ((delimiters
+ (append (white-space) *supported-brackets* (list "}")))
+ (result (get-literal (subseq filter-string first-pos)))
+ (literal-value (getf result :literal))
+ (next-string (getf result :next-string))
+ (lang
+ (when (string-starts-with next-string "@")
+ (let ((end-pos (search-first delimiters next-string)))
+ (when end-pos
+ (subseq next-string 0 end-pos)))))
+ (type
+ (when (string-starts-with next-string "^^")
+ (let ((end-pos
+ (let ((pos (search-first delimiters next-string)))
+ (if pos
+ pos
+ (length next-string)))))
+ (when end-pos
+ (subseq next-string 2 end-pos)))))
+ (modified-literal-value
+ (if type
+ (if (> (length literal-value) 0)
+ (string-trim (list (elt literal-value 0)) literal-value)
+ literal-value)
+ literal-value)))
+ (concat (subseq filter-string 0 first-pos)
+ (if type
+ (write-to-string
+ (cast-literal modified-literal-value type
+ :back-as-string-when-unsupported t))
+ modified-literal-value)
+ (cast-literal-constants
+ construct
+ (subseq next-string (cond (lang (length lang))
+ (type (+ 2 (length type)))
+ (t 0))))))))))
+
+
(defgeneric scan-filter-for-deprecated-calls (construct filter-string
original-filter)
(:documentation "Returns the passed filter-string where all functions
@@ -695,7 +744,7 @@
(declare (String filter-string)
(Integer idx))
(let* ((string-after (subseq filter-string (1+ idx)))
- (cleaned-str (cut-comment string-after)))
+ (cleaned-str (trim-whitespace-left string-after)))
(cond ((string-starts-with cleaned-str "(")
(let ((result (bracket-scope cleaned-str)))
(list :next-query (string-after cleaned-str result)
@@ -741,14 +790,14 @@
that is the scope of the function, i.e. the function name and all its
variable including the closing )."
(declare (String str))
- (let* ((cleaned-str (cut-comment str))
+ (let* ((cleaned-str (trim-whitespace-left str))
(after-fun
(remove-null (map 'list #'(lambda(fun)
(when (string-starts-with cleaned-str fun)
(string-after str fun)))
*supported-functions*)))
(fun-suffix (when after-fun
- (cut-comment (first after-fun)))))
+ (trim-whitespace-left (first after-fun)))))
(when fun-suffix
(let* ((args (bracket-scope fun-suffix))
(fun-name (string-until cleaned-str args)))
@@ -864,11 +913,6 @@
(setf idx (- (1- (length query-string))
(length (getf result :next-string))))
(push-string (getf result :literal) filter-string)))
- ((string= "#" current-char)
- (let ((comment-string
- (string-until (subseq query-string idx)
- (string #\newline))))
- (setf idx (+ idx (length comment-string)))))
((and (string= current-char (string #\newline))
(= 0 open-brackets))
(setf result
Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp (original)
+++ trunk/src/base-tools/base-tools.lisp Wed Apr 6 11:02:36 2011
@@ -280,7 +280,7 @@
"Returns the end of the literal corresponding to the passed delimiter
string. The query-string must start after the opening literal delimiter.
The return value is an int that represents the start index of closing
- delimiter. delimiter must be either \", ', or '''.
+ delimiter. delimiter must be either \", ', \"\"\", or '''.
If the returns value is nil, there is no closing delimiter."
(declare (String query-string delimiter)
(Integer overall-pos))
@@ -297,7 +297,7 @@
(defun get-literal-quotation (str)
"Returns ', ''', \" or \"\"\" when the string starts with a literal delimiter."
(cond ((string-starts-with str "'''")
- "'")
+ "'''")
((string-starts-with str "\"\"\"")
"\"\"\"")
((string-starts-with str "'")
Modified: trunk/src/unit_tests/sparql_test.lisp
==============================================================================
--- trunk/src/unit_tests/sparql_test.lisp (original)
+++ trunk/src/unit_tests/sparql_test.lisp Wed Apr 6 11:02:36 2011
@@ -1546,9 +1546,9 @@
(with-revision 0
(let* ((query-1
"BASE <http://some.where/psis/poem/>
- SELECT $subject ?predicate WHERE{
- ?subject $predicate <zauberlehrling> .
- FILTER (STR(?predicate) = 'http://some.where/base-psis/written')}")
+ SELECT $subject ?predicate WHERE{
+ ?subject $predicate <zauberlehrling> .
+ FILTER (STR(?predicate) = 'http://some.where/base-psis/written')}")
(query-2 "SELECT ?object ?subject WHERE{
<http://some.where/psis/author/goethe> ?predicate ?object .
FILTER (isLITERAL(?object) &&
@@ -2364,8 +2364,8 @@
(let* ((q-1 (concat
"SELECT * WHERE {
<http://some.where/tmsparql/author/goethe> ?pred1 ?obj1.
- FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
- #FILTER ?obj1 = 'von Goethe' || ?obj1 = '82'^^" *xml-integer* "
+ #FILTER ?obj1 = 'von Goethe' || ?obj1 = 82
+ FILTER ?obj1 = 'von Goethe'^^" *xml-string* " || ?obj1 = '82'^^" *xml-integer* "
#FILTER (?obj1 = 'von Goethe' || 82 = ?obj1)
#FILTER (?obj1 = 'von Goethe') || (82 = ?obj1)
#FILTER ((?obj1 = 'von Goethe') || (82 = ?obj1))"
@@ -2373,17 +2373,6 @@
}"))
(r-1 (tm-sparql:result (make-instance 'TM-SPARQL:SPARQL-Query :query q-1))))
-
- ;(map 'list #'(lambda(triple)
- ;(format t "~a - ~a - ~a[~a]~%"
- ;(tm-sparql::subject-result triple)
- ;(tm-sparql::predicate-result triple)
- ;(tm-sparql::object-result triple)
- ;(tm-sparql::object-datatype triple)))
- ;(tm-sparql::select-group (make-instance 'TM-SPARQL:SPARQL-Query :query q-1)))
-
-
-
(is-true (= (length r-1) 2))
(map 'list #'(lambda(item)
(cond
@@ -2395,7 +2384,6 @@
(format t "~a~%" r-1))))
-;TODO: cast literal-values when called in filters
;TODO: test complex filters
(defun run-sparql-tests ()
More information about the Isidorus-cvs
mailing list