Changeset 381 for trunk/src/TM-SPARQL

Timestamp:

12/20/10 20:47:48 (14 years ago)

Author:

lgiessmann

Message:

TM-SPARQL: fixed the type-handling in FILTERs when there is given something like 'xyz'anyType

Location:

trunk/src/TM-SPARQL

Files:

• filter_wrappers.lisp (modified) (3 diffs)
• sparql.lisp (modified) (1 diff)
• sparql_filter.lisp (modified) (1 diff)
• sparql_parser.lisp (modified) (1 diff)

trunk/src/TM-SPARQL/filter_wrappers.lisp ¶

@@ -14 +14 @@
 
 
+(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)))))
 
 
@@ -65 +100 @@
 
 (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))))
 
 
@@ -93 +130 @@
 
 (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

trunk/src/TM-SPARQL/sparql.lisp ¶

@@ -1011 +1011 @@
 
 
+(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))

trunk/src/TM-SPARQL/sparql_filter.lisp ¶

@@ -122 +122 @@
                    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
 
 

trunk/src/TM-SPARQL/sparql_parser.lisp ¶

@@ -218 +218 @@
 
 
-(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