[isidorus-cvs] r376 - in trunk/src: . TM-SPARQL base-tools
Lukas Giessmann
lgiessmann at common-lisp.net
Sun Dec 19 21:00:03 UTC 2010
Author: lgiessmann
Date: Sun Dec 19 16:00:02 2010
New Revision: 376
Log:
TM-SPARQL: implemented all wrapper functions for filters in a separate package
Added:
trunk/src/TM-SPARQL/filter_wrappers.lisp
Modified:
trunk/src/TM-SPARQL/sparql.lisp
trunk/src/TM-SPARQL/sparql_filter.lisp
trunk/src/TM-SPARQL/sparql_parser.lisp
trunk/src/base-tools/base-tools.lisp
trunk/src/isidorus.asd
Added: trunk/src/TM-SPARQL/filter_wrappers.lisp
==============================================================================
--- (empty file)
+++ trunk/src/TM-SPARQL/filter_wrappers.lisp Sun Dec 19 16:00:02 2010
@@ -0,0 +1,146 @@
+;;+-----------------------------------------------------------------------------
+;;+ 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 :filter-functions
+ (:use :base-tools :constants :tm-sparql))
+
+
+(defun filter-functions::not(x)
+ (not x))
+
+
+(defun filter-functions::one+(x)
+ (1+ x))
+
+
+(defun filter-functions::one-(x)
+ (1- x))
+
+
+(defun filter-functions::+(x y)
+ (+ x y))
+
+
+(defun filter-functions::-(x y)
+ (- x y))
+
+
+(defun filter-functions::*(x y)
+ (* x y))
+
+
+(defun filter-functions::/(x y)
+ (/ x y))
+
+
+(defun filter-functions::or(x y)
+ (or x y))
+
+
+(defun filter-functions::and(x y)
+ (and x 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))))
+
+
+(defun filter-functions::!=(x y)
+ (filter-functions::not
+ (filter-functions::= x y)))
+
+
+(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)))
+
+
+(defun filter-functions::>(x y)
+ (filter-functions::not
+ (filter-functions::< x y)))
+
+
+(defun filter-functions::<=(x y)
+ (filter-functions::or
+ (filter-functions::< x y)
+ (filter-functions::= x y)))
+
+
+(defun filter-functions::>=(x y)
+ (filter-functions::or
+ (filter-functions::> x y)
+ (filter-functions::= x y)))
+
+
+(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))
+ (local-pattern
+ (if (find #\x flags)
+ (base-tools:string-replace
+ (base-tools:string-replace
+ (base-tools:string-replace
+ (base-tools:string-replace pattern (string #\newline) "")
+ (string #\tab) "") (string #\cr) "") " " "")
+ pattern))
+ (scanner
+ (ppcre:create-scanner local-pattern
+ :case-insensitive-mode case-insensitive
+ :multi-line-mode multi-line
+ :single-line-mode single-line)))
+ (ppcre:scan scanner str)))
+
+
+(defun filter-functions::bound(x)
+ (boundp x))
+
+
+(defun filter-functions::isLITERAL(x)
+ (or (numberp x)
+ (not (and (base-tools:string-starts-with x "<")
+ (base-tools:string-ends-with x ">")
+ (base-tools:absolute-uri-p x)))))
+
+
+(defun filter-functions::datatype(x)
+ (let ((type-suffix
+ (when (and (stringp x)
+ (or (base-tools:string-starts-with x "'")
+ (base-tools:string-starts-with x "\"")))
+ (let* ((result (base-tools:get-literal x))
+ (literal-datatype
+ (when (base-tools:string-starts-with
+ (getf result :next-string) "^^")
+ (subseq (getf result :next-string) 2))))
+ literal-datatype))))
+ (cond (type-suffix type-suffix)
+ ((integerp x) constants::*xml-integer*)
+ ((floatp x) constants::*xml-decimal*)
+ ((numberp x) constants::*xml-double*)
+ ((stringp x) constants::*xml-string*)
+ (t (type-of x)))))
+
+
+(defun filter-functions::str(x)
+ ;TODO: implement
+ )
\ No newline at end of file
Modified: trunk/src/TM-SPARQL/sparql.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql.lisp (original)
+++ trunk/src/TM-SPARQL/sparql.lisp Sun Dec 19 16:00:02 2010
@@ -132,8 +132,8 @@
;purposes and mustn't be reset
:type List
:initform nil
- :documentation "A list of the form that contains the variable
- names as string.")
+ :documentation "A list of that contains the variable
+ names as strings.")
(prefixes :initarg :prefixes
:accessor prefixes ;this value is only for internal purposes
;purposes and mustn't be reset
@@ -154,15 +154,31 @@
:type List
:initform nil
:documentation "Contains a SPARQL-Group that represents
- the entire inner select-where statement."))
+ the entire inner select-where statement.")
+ (filters :initarg filters
+ :accessor filters ;this value is only for internal purposes
+ ;purposes and mustn't be reset
+ :type List ;a list of strings
+ :initform nil
+ :documentation "Contains strings, each string represents a filter
+ that was transformed to lisp code and can be evoked
+ on each triple in the list select-group."))
(:documentation "This class represents the entire request."))
(defgeneric *-p (construct)
(:documentation "Returns t if the user selected all variables with *.")
(:method ((construct SPARQL-Query))
- (and (= (length (variables construct)) 1)
- (string= (first (variables construct)) "*"))))
+ (loop for var in (variables construct)
+ when (string= var "*")
+ return t)))
+
+
+(defgeneric add-filter (construct filter)
+ (:documentation "Pushes the filter string to the corresponding list in
+ the construct.")
+ (:method ((construct SPARQL-Query) (filter String))
+ (push filter (filters construct))))
(defmethod variables ((construct SPARQL-Triple))
@@ -236,6 +252,38 @@
(push variable-name (variables construct)))))
+(defgeneric invoke-filter (construct filter-string)
+ (:documentation "Invokes the passed filter on the construct that
+ represents a sparql result.")
+ (:method ((construct SPARQL-Triple) (filter-string String))
+ (dotimes (row-idx (length (subject-result construct)))
+ (let* ((subj-var
+ (when (variable-p (subject construct))
+ (concatenate 'string "(" (value (subject construct))
+ " " (elt (subject-result construct) row-idx) ")")))
+ (pred-var
+ (when (variable-p (predicate construct))
+ (concatenate 'string "(" (value (predicate construct))
+ " " (elt (predicate-result construct) row-idx) ")")))
+ (obj-var
+ (when (variable-p (object construct))
+ (concatenate 'string "(" (value (object construct))
+ " " (elt (object-result construct) row-idx) ")")))
+ (var-let
+ (if (or subj-var pred-var obj-var)
+ (concatenate 'string "(let (" subj-var pred-var obj-var ")")
+ "(let ()"))
+ (expression (concatenate 'string var-let filter-string ")")))
+
+ ))
+ ;TODO: implement
+ ;; *implement a method "invoke-filter(SPARQL-Triple filter-string)" so
+ ;; that the variables are automatically contained in a let afterwards
+ ;; the eval function can be called this method should also have a let
+ ;; with (true t) and (false nil)
+ ))
+
+
(defgeneric set-results (construct &key revision)
(:documentation "Calculates the result of a triple and set all the values in
the passed object.")
@@ -766,18 +814,16 @@
(defgeneric result (construct)
(:documentation "Returns the result of the entire query.")
(:method ((construct SPARQL-Query))
- (let ((result-lists (make-result-lists construct)))
- (reduce-results construct result-lists)
- (let* ((response-variables
- (reverse (if (*-p construct)
- (all-variables construct)
- (variables construct))))
- (cleaned-results (make-result-lists construct)))
- (map 'list #'(lambda(response-variable)
- (list :variable response-variable
- :result (variable-intersection response-variable
- cleaned-results)))
- response-variables)))))
+ (let* ((response-variables
+ (reverse (if (*-p construct)
+ (all-variables construct)
+ (variables construct))))
+ (cleaned-results (make-result-lists construct)))
+ (map 'list #'(lambda(response-variable)
+ (list :variable response-variable
+ :result (variable-intersection response-variable
+ cleaned-results)))
+ response-variables))))
(defgeneric make-result-lists (construct)
@@ -939,4 +985,10 @@
(parser-start construct (original-query construct))
(dolist (triple (select-group construct))
(set-results triple :revision (revision construct)))
+ ;; filters all entries that are not important for the result
+ ;; => an intersection is invoked
+ (reduce-results construct (make-result-lists construct))
+ (dolist (triple (select-group construct))
+ (dolist (filter (filters construct))
+ (invoke-filter triple filter)))
construct)
\ No newline at end of file
Modified: trunk/src/TM-SPARQL/sparql_filter.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_filter.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_filter.lisp Sun Dec 19 16:00:02 2010
@@ -117,18 +117,17 @@
(set-compare-operators construct filter-string-arithmetic-ops))
(filter-string-functions
(set-functions construct filter-string-compare-ops)))
- (list :next-query next-query
- :filter-string (scan-filter-for-deprecated-calls
- construct filter-string-functions original-filter-string)))))
+ (add-filter construct
+ (scan-filter-for-deprecated-calls
+ construct filter-string-functions original-filter-string))
+ (parse-group construct next-query))))
;;TODO: implement
;; *implement wrapper functions, also for the operators
- ;; it would be nice of the self defined operator functions would be in a
+ ;; it would be nice when the self defined operator functions would be in a
;; separate packet, e.g. filter-functions, so =, ... would couse no
;; collisions
- ;; *create and store this filter object => store the created string and implement
- ;; a method "invoke-filter(SPARQL-Triple filter-string)" so that the variables
- ;; are automatically contained in a letafterwards the eval function can be called
- ;; this method should also have a let with (true t) and (false nil)
+ ;; *add ^^datatype to the object-literal-results
+ ;; *implement to-literal => CharacteristicC => \"...\"^^datatype => use for tm-sparql
(defgeneric scan-filter-for-deprecated-calls (construct filter-string
@@ -677,10 +676,8 @@
(push-string current-char result-string))))
((or (string= current-char "'")
(string= current-char "\""))
- (let* ((sub-str (subseq filter-string idx))
- (quotation (get-literal-quotation sub-str))
- (literal
- (get-literal (subseq filter-string idx) :quotation quotation)))
+ (let ((literal
+ (get-literal (subseq filter-string idx))))
(if literal
(progn
(setf idx (- (1- (length filter-string))
@@ -710,7 +707,7 @@
(list :next-query (string-after cleaned-str result)
:scope result)))
((string-starts-with cleaned-str "\"")
- (let ((result (get-literal cleaned-str)))
+ (let ((result (get-literal cleaned-str :quotation "\"")))
(list :next-query (getf result :next-string)
:scope (getf result :literal))))
((string-starts-with-digit cleaned-str)
@@ -807,10 +804,7 @@
(let ((current-char (subseq str idx (1+ idx))))
(cond ((or (string= "'" current-char)
(string= "\"" current-char))
- (let* ((sub-str (subseq str idx))
- (quotation (get-literal-quotation sub-str))
- (literal
- (get-literal (subseq str idx) :quotation quotation)))
+ (let ((literal (get-literal (subseq str idx))))
(if literal
(progn
(setf idx (- (1- (length str))
@@ -861,7 +855,8 @@
(push-string current-char filter-string))
((or (string= "'" current-char)
(string= "\"" current-char))
- (let ((result (get-literal (subseq query-string idx))))
+ (let ((result
+ (get-literal (subseq query-string idx) :quotation "\"")))
(unless result
(error (make-sparql-parser-condition
(subseq query-string idx)
Modified: trunk/src/TM-SPARQL/sparql_parser.lisp
==============================================================================
--- trunk/src/TM-SPARQL/sparql_parser.lisp (original)
+++ trunk/src/TM-SPARQL/sparql_parser.lisp Sun Dec 19 16:00:02 2010
@@ -95,7 +95,9 @@
(error (make-sparql-parser-condition trimmed-str
(original-query construct) "{")))
(let ((query-tail (parse-group construct (subseq trimmed-str 1))))
- ;TODO: process query-tail
+ (when (> (length (trim-whitespace query-tail)) 0)
+ (make-sparql-parser-condition
+ query-tail (original-query construct) "end of query, solution sequences and modifiers are not supported"))
query-tail))))
@@ -125,7 +127,6 @@
trimmed-str (original-query construct)
"FILTER, BASE, or triple. Grouping is currently no implemented.")))
((string-starts-with trimmed-str "}") ;ending of this group
- ;TODO: invoke filters with all results on construct in initialize :after
(subseq trimmed-str 1))
(t
(parse-triple construct trimmed-str :last-subject last-subject))))))
@@ -249,9 +250,7 @@
literal-value literal-type))))
value))
(t ; return the value as a string
- (if (stringp literal-value)
- literal-value
- (write-to-string literal-value)))))
+ literal-value)))
(defgeneric separate-literal-lang-or-type (construct query-string)
Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp (original)
+++ trunk/src/base-tools/base-tools.lisp Sun Dec 19 16:00:02 2010
@@ -294,49 +294,37 @@
"\"")))
-(defun get-literal (query-string &key (quotation "\""))
+(defun get-literal (query-string &key (quotation nil))
"Returns a list of the form (:next-string <string> :literal <string>
where next-query is the query after the found literal and literal
is the literal string."
(declare (String query-string)
- (String quotation))
- (cond ((or (string-starts-with query-string "\"\"\"")
- (string-starts-with query-string "'''"))
- (let ((literal-end
- (find-literal-end (subseq query-string 3) (subseq query-string 0 3))))
- (when literal-end
- (list :next-string (subseq query-string (+ 3 literal-end))
- :literal (concatenate 'string quotation
- (subseq query-string 3 literal-end)
- quotation)))))
- ((or (string-starts-with query-string "\"")
- (string-starts-with query-string "'"))
- (let ((literal-end
- (find-literal-end (subseq query-string 1)
- (subseq query-string 0 1))))
- (when literal-end
- (let ((literal
- (escape-string (subseq query-string 1 literal-end) "\"")))
- (list :next-string (subseq query-string (+ 1 literal-end))
- :literal (concatenate 'string quotation literal
- quotation))))))))
-
-
-;(defun search-first-ignore-literals (search-strings main-string)
-; (declare (String main-string)
-; (List search-strings))
-; (let ((first-pos (search-first search-strings main-string)))
-; (when first-pos
-; (if (not (in-literal-string-p main-string first-pos))
-; first-pos
-; (let* ((literal-start (search-first (list "\"" "'") main-string))
-; (sub-str (subseq main-string literal-start))
-; (literal-result (get-literal sub-str))
-; (next-str (getf literal-result :next-string)))
-; (let ((next-pos
-; (search-first-ignore-literals search-strings next-str)))
-; (when next-pos
-; (+ (- (length main-string) (length next-str)) next-pos))))))))
+ (type (or Null String) quotation))
+ (let ((local-quotation quotation))
+ (cond ((or (string-starts-with query-string "\"\"\"")
+ (string-starts-with query-string "'''"))
+ (unless local-quotation
+ (setf local-quotation (subseq query-string 0 3)))
+ (let ((literal-end
+ (find-literal-end (subseq query-string 3) (subseq query-string 0 3))))
+ (when literal-end
+ (list :next-string (subseq query-string (+ 3 literal-end))
+ :literal (concatenate 'string quotation
+ (subseq query-string 3 literal-end)
+ quotation)))))
+ ((or (string-starts-with query-string "\"")
+ (string-starts-with query-string "'"))
+ (unless local-quotation
+ (setf local-quotation (subseq query-string 0 1)))
+ (let ((literal-end
+ (find-literal-end (subseq query-string 1)
+ (subseq query-string 0 1))))
+ (when literal-end
+ (let ((literal
+ (escape-string (subseq query-string 1 literal-end) "\"")))
+ (list :next-string (subseq query-string (+ 1 literal-end))
+ :literal (concatenate 'string local-quotation literal
+ local-quotation)))))))))
(defun search-first-ignore-literals (search-strings main-string &key from-end)
Modified: trunk/src/isidorus.asd
==============================================================================
--- trunk/src/isidorus.asd (original)
+++ trunk/src/isidorus.asd Sun Dec 19 16:00:02 2010
@@ -1,4 +1,3 @@
-;;-*- mode: lisp -*-
;;+-----------------------------------------------------------------------------
;;+ Isidorus
;;+ (c) 2008-2010 Marc Kuester, Christoph Ludwig, Lukas Georgieff
@@ -42,8 +41,9 @@
:depends-on ("constants" "base-tools"))
(:module "TM-SPARQL"
:components ((:file "sparql")
+ (:file "filter_wrappers")
(:file "sparql_filter"
- :depends-on ("sparql"))
+ :depends-on ("sparql" "filter_wrappers"))
(:file "sparql_parser"
:depends-on ("sparql" "sparql_filter")))
:depends-on ("constants" "base-tools" "model"))
More information about the Isidorus-cvs
mailing list