[isidorus-cvs] r381 - in trunk/src: . TM-SPARQL
Lukas Giessmann
lgiessmann at common-lisp.net
Mon Dec 20 20:47:48 UTC 2010
Author: lgiessmann
Date: Mon Dec 20 15:47:48 2010
New Revision: 381
Log:
TM-SPARQL: fixed the type-handling in FILTERs when there is given something like 'xyz'^^anyType
Modified:
trunk/src/TM-SPARQL/filter_wrappers.lisp
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_filter.lisp
trunk/src/TM-SPARQL/sparql_parser.lisp
trunk/src/isidorus.asd
Modified: trunk/src/TM-SPARQL/filter_wrappers.lisp
==============================================================================
--- trunk/src/TM-SPARQL/filter_wrappers.lisp (original)
+++ trunk/src/TM-SPARQL/filter_wrappers.lisp Mon Dec 20 15:47:48 2010
@@ -13,49 +13,84 @@
(:import-from :cl progn handler-case let))
+(defun filter-functions::normalize-value (value)
+ "Returns the normalized value, i.e. if a literal
+ is passed as '12'^^xsd:integer 12 is returned."
+ (cond ((not (stringp value))
+ value)
+ ((or (base-tools:string-starts-with value "'")
+ (base-tools:string-starts-with value "\""))
+ (let* ((literal-result (tm-sparql::get-literal value))
+ (literal-value
+ (cond ((or (base-tools:string-starts-with
+ (getf literal-result :literal) "\"\"\"")
+ (base-tools:string-starts-with
+ (getf literal-result :literal) "'''"))
+ (subseq (getf literal-result :literal) 3
+ (- (length (getf literal-result :literal)) 3)))
+ (t
+ (subseq (getf literal-result :literal) 1
+ (- (length (getf literal-result :literal)) 1)))))
+ (given-datatype
+ (when (base-tools:string-starts-with
+ (getf literal-result :next-string) "^^")
+ (subseq (getf literal-result :next-string) 2))))
+ (tm-sparql::cast-literal literal-value given-datatype)))
+ (t
+ value)))
+
+
(defun filter-functions::not(x)
- (not x))
+ (not (filter-functions::normalize-value x)))
(defun filter-functions::one+(x)
- (1+ x))
+ (1+ (filter-functions::normalize-value x)))
(defun filter-functions::one-(x)
- (1- x))
+ (1- (filter-functions::normalize-value x)))
(defun filter-functions::+(x y)
- (+ x y))
+ (+ (filter-functions::normalize-value x)
+ (filter-functions::normalize-value y)))
(defun filter-functions::-(x y)
- (- x y))
+ (- (filter-functions::normalize-value x)
+ (filter-functions::normalize-value y)))
(defun filter-functions::*(x y)
- (* x y))
+ (* (filter-functions::normalize-value x)
+ (filter-functions::normalize-value y)))
(defun filter-functions::/(x y)
- (/ x y))
+ (/ (filter-functions::normalize-value x)
+ (filter-functions::normalize-value y)))
(defun filter-functions::or(x y)
- (or x y))
+ (or (filter-functions::normalize-value x)
+ (filter-functions::normalize-value y)))
(defun filter-functions::and(x y)
- (and x y))
+ (and (filter-functions::normalize-value x)
+ (filter-functions::normalize-value y)))
(defun filter-functions::=(x y)
- (cond ((and (stringp x) (stringp y))
- (string= x y))
- ((and (numberp x)( numberp y))
- (= x y))
- (t
- (eql x y))))
+ (let ((local-x (filter-functions::normalize-value x))
+ (local-y (filter-functions::normalize-value y)))
+ (cond ((and (stringp local-x) (stringp local-y))
+ (string= local-x local-y))
+ ((and (numberp local-x)( numberp local-y))
+ (= local-x local-y))
+ (t
+ (eql local-x local-y)))))
(defun filter-functions::!=(x y)
@@ -64,14 +99,16 @@
(defun filter-functions::<(x y)
- (cond ((and (numberp x) (numberp y))
- (< x y))
- ((and (stringp x) (stringp y))
- (string< x y))
- ((and (typep x 'Boolean) (typep y 'Boolean))
- (and (not x) y))
- (t
- nil)))
+ (let ((local-x (filter-functions::normalize-value x))
+ (local-y (filter-functions::normalize-value y)))
+ (cond ((and (numberp local-x) (numberp local-y))
+ (< local-x local-y))
+ ((and (stringp local-x) (stringp local-y))
+ (string< local-x local-y))
+ ((and (typep local-x 'Boolean) (typep local-y 'Boolean))
+ (and (not local-x) local-y))
+ (t
+ nil))))
(defun filter-functions::>(x y)
@@ -92,18 +129,20 @@
(defun filter-functions::regex(str pattern &optional flags)
- (declare (Ignorable flags))
- (let* ((case-insensitive (when (find #\i flags) t))
- (multi-line (when (find #\m flags) t))
- (single-line (when (find #\s flags) t))
+ (let* ((local-flags (filter-functions::normalize-value flags))
+ (case-insensitive (when (find #\i local-flags) t))
+ (multi-line (when (find #\m local-flags) t))
+ (single-line (when (find #\s local-flags) t))
(local-pattern
- (if (find #\x flags)
+ (if (find #\x local-flags)
(base-tools:string-replace
(base-tools:string-replace
(base-tools:string-replace
- (base-tools:string-replace pattern (string #\newline) "")
+ (base-tools:string-replace
+ (filter-functions::normalize-value pattern)
+ (string #\newline) "")
(string #\tab) "") (string #\cr) "") " " "")
- pattern))
+ (filter-functions::normalize-value pattern)))
(scanner
(ppcre:create-scanner local-pattern
:case-insensitive-mode case-insensitive
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Mon Dec 20 15:47:48 2010
@@ -1010,6 +1010,42 @@
values)))
+(defun cast-literal (literal-value literal-type)
+ "A helper function that casts the passed string value of the literal
+ corresponding to the passed literal-type."
+ (declare (String literal-value literal-type))
+ (cond ((string= literal-type *xml-string*)
+ literal-value)
+ ((string= literal-type *xml-boolean*)
+ (when (and (string/= literal-value "false")
+ (string/= literal-value "true"))
+ (error (make-condition
+ 'sparql-parser-error
+ :message (format nil "Could not cast from ~a to ~a"
+ literal-value literal-type))))
+ (if (string= literal-value "false")
+ nil
+ t))
+ ((string= literal-type *xml-integer*)
+ (handler-case (parse-integer literal-value)
+ (condition ()
+ (error (make-condition
+ 'sparql-parser-error
+ :message (format nil "Could not cast from ~a to ~a"
+ literal-value literal-type))))))
+ ((or (string= literal-type *xml-decimal*) ;;both types are
+ (string= literal-type *xml-double*)) ;;handled the same way
+ (let ((value (read-from-string literal-value)))
+ (unless (numberp value)
+ (error (make-condition
+ 'sparql-parser-error
+ :message (format nil "Could not cast from ~a to ~a"
+ literal-value literal-type))))
+ value))
+ (t ; return the value as a string
+ literal-value)))
+
+
(defmethod initialize-instance :after ((construct SPARQL-Query) &rest args)
(declare (ignorable args))
(parser-start construct (original-query construct))
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp Mon Dec 20 15:47:48 2010
@@ -121,10 +121,6 @@
(scan-filter-for-deprecated-calls
construct filter-string-functions original-filter-string))
(parse-group construct next-query))))
- ;;TODO: implement
- ;; *add ^^datatype to the object-literal-results
- ;; *implement to-literal => CharacteristicC => \"...\"^^datatype => use for tm-sparql
- ;; *implement str correctly
(defgeneric scan-filter-for-deprecated-calls (construct filter-string
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp Mon Dec 20 15:47:48 2010
@@ -217,42 +217,6 @@
:value (cast-literal l-value l-type)))))
-(defun cast-literal (literal-value literal-type)
- "A helper function that casts the passed string value of the literal
- corresponding to the passed literal-type."
- (declare (String literal-value literal-type))
- (cond ((string= literal-type *xml-string*)
- literal-value)
- ((string= literal-type *xml-boolean*)
- (when (and (string/= literal-value "false")
- (string/= literal-value "true"))
- (error (make-condition
- 'sparql-parser-error
- :message (format nil "Could not cast from ~a to ~a"
- literal-value literal-type))))
- (if (string= literal-value "false")
- nil
- t))
- ((string= literal-type *xml-integer*)
- (handler-case (parse-integer literal-value)
- (condition ()
- (error (make-condition
- 'sparql-parser-error
- :message (format nil "Could not cast from ~a to ~a"
- literal-value literal-type))))))
- ((or (string= literal-type *xml-decimal*) ;;both types are
- (string= literal-type *xml-double*)) ;;handled the same way
- (let ((value (read-from-string literal-value)))
- (unless (numberp value)
- (error (make-condition
- 'sparql-parser-error
- :message (format nil "Could not cast from ~a to ~a"
- literal-value literal-type))))
- value))
- (t ; return the value as a string
- literal-value)))
-
-
(defgeneric separate-literal-lang-or-type (construct query-string)
(:documentation "A helper function that returns (:next-query string
:lang string :type string). Only one of :lang and
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Mon Dec 20 15:47:48 2010
@@ -41,7 +41,8 @@
:depends-on ("constants" "base-tools"))
(:module "TM-SPARQL"
:components ((:file "sparql")
- (:file "filter_wrappers")
+ (:file "filter_wrappers"
+ :depends-on ("sparql"))
(:file "sparql_filter"
:depends-on ("sparql" "filter_wrappers"))
(:file "sparql_parser"
More information about the Isidorus-cvs
mailing list