[isidorus-cvs] r382 - trunk/src/base-tools

[Lukas Giessmann]

Author: lgiessmann
Date: Tue Dec 21 15:20:36 2010
New Revision: 382

Log:
TM-SPARQL: fixed a bug in search-firstunclosed-paranthesis when the string contains string-literals; added the macro concat which is a shortcut for concatenate 'string ... 

Modified:
   trunk/src/base-tools/base-tools.lisp

Modified: trunk/src/base-tools/base-tools.lisp
==============================================================================
--- trunk/src/base-tools/base-tools.lisp	(original)
+++ trunk/src/base-tools/base-tools.lisp	Tue Dec 21 15:20:36 2010
@@ -11,6 +11,7 @@
   (:use :cl)
   (:nicknames :tools)
   (:export :push-string
+	   :concat
 	   :when-do
 	   :string-replace
 	   :remove-null
@@ -64,6 +65,10 @@
   `(setf ,place (concatenate 'string ,place ,obj)))
 
 
+(defmacro concat (&rest strings)
+  `(concatenate 'string , at strings))
+
+
 (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.
@@ -449,15 +454,14 @@
 (defun search-first-unclosed-paranthesis (str &key ignore-literals)
   "Returns the idx of the first ( that is not closed, the search is
    started from the end of the string.
-   If ignore-literals is set to t all mparanthesis that are within
+   If ignore-literals is set to t all paranthesis that are within
    \", \"\"\", ' and ''' are ignored."
   (declare (String str)
 	   (Boolean ignore-literals))
-  (let ((r-str (reverse str))
-	(open-brackets 0)
+  (let ((open-brackets 0)
 	(result-idx nil))
-    (dotimes (idx (length r-str))
-      (let ((current-char (subseq r-str idx (1+ idx))))
+    (do ((idx (1- (length str)))) ((< idx 0))
+      (let ((current-char (subseq str idx (1+ idx))))
 	(cond ((string= current-char ")")
 	       (when (or ignore-literals
 			 (not (in-literal-string-p str idx)))
@@ -468,9 +472,9 @@
 		 (incf open-brackets)
 		 (when (> open-brackets 0)
 		   (setf result-idx idx)
-		   (setf idx (length r-str))))))))
-    (when result-idx
-      (- (length str) (1+ result-idx)))))
+		   (setf idx 0)))))
+	(decf idx)))
+    result-idx))
 
 
 (defun search-first-unopened-paranthesis (str &key ignore-literals)