X-Git-Url: http://git.kpe.io/?p=clsql.git;a=blobdiff_plain;f=sql%2Fsql.lisp;fp=sql%2Fsql.lisp;h=6bc454724621bf4adbbc76ddfdbae63caff5b9a3;hp=0a733aa81035c787e3a12d2c51bf0eb010b4f5a2;hb=e303385b84c6246c7d60ebd95d764a282a181a23;hpb=21ffe5f820036726c6353a16dfb478fb41aa700c

diff --git a/sql/sql.lisp b/sql/sql.lisp
index 0a733aa..6bc4547 100644
--- a/sql/sql.lisp
+++ b/sql/sql.lisp
@@ -361,62 +361,85 @@ MAP."
   (multiple-value-bind (result-set columns)
       (database-query-result-set query-expression database :full-set nil
 				 :result-types result-types)
-    (when result-set
-      (unwind-protect
-	   (do ((row (make-list columns)))
-	       ((not (database-store-next-row result-set database row))
-		nil)
-	     (apply function row))
-	(database-dump-result-set result-set database)))))
+    (let ((flatp (and (= columns 1) 
+                      (typecase query-expression 
+                        (string t) 
+                        (sql-query 
+                         (slot-value query-expression 'flatp))))))
+      (when result-set
+        (unwind-protect
+             (do ((row (make-list columns)))
+                 ((not (database-store-next-row result-set database row))
+                  nil)
+               (if flatp
+                   (apply function row)
+                   (funcall function row)))
+          (database-dump-result-set result-set database))))))
 		     
 (defun map-query-to-list (function query-expression database result-types)
   (multiple-value-bind (result-set columns)
       (database-query-result-set query-expression database :full-set nil
 				 :result-types result-types)
-    (when result-set
-      (unwind-protect
-	   (let ((result (list nil)))
-	     (do ((row (make-list columns))
-		  (current-cons result (cdr current-cons)))
-		 ((not (database-store-next-row result-set database row))
-		  (cdr result))
-	       (rplacd current-cons (list (apply function row)))))
-	(database-dump-result-set result-set database)))))
-
+    (let ((flatp (and (= columns 1) 
+                      (typecase query-expression 
+                        (string t) 
+                        (sql-query 
+                         (slot-value query-expression 'flatp))))))
+      (when result-set
+        (unwind-protect
+             (let ((result (list nil)))
+               (do ((row (make-list columns))
+                    (current-cons result (cdr current-cons)))
+                   ((not (database-store-next-row result-set database row))
+                    (cdr result))
+                 (rplacd current-cons 
+                         (list (if flatp 
+                                   (apply function row)
+                                   (funcall function (copy-list row)))))))
+          (database-dump-result-set result-set database))))))
 
 (defun map-query-to-simple (output-type-spec function query-expression database result-types)
   (multiple-value-bind (result-set columns rows)
       (database-query-result-set query-expression database :full-set t
 				 :result-types result-types)
-    (when result-set
-      (unwind-protect
-	   (if rows
-	       ;; We know the row count in advance, so we allocate once
-	       (do ((result
-		     (cmucl-compat:make-sequence-of-type output-type-spec rows))
-		    (row (make-list columns))
-		    (index 0 (1+ index)))
-		   ((not (database-store-next-row result-set database row))
-		    result)
-		 (declare (fixnum index))
-		 (setf (aref result index)
-		       (apply function row)))
-	       ;; Database can't report row count in advance, so we have
-	       ;; to grow and shrink our vector dynamically
-	       (do ((result
-		     (cmucl-compat:make-sequence-of-type output-type-spec 100))
-		    (allocated-length 100)
-		    (row (make-list columns))
-		    (index 0 (1+ index)))
-		   ((not (database-store-next-row result-set database row))
-		    (cmucl-compat:shrink-vector result index))
-		 (declare (fixnum allocated-length index))
-		 (when (>= index allocated-length)
-		   (setq allocated-length (* allocated-length 2)
-			 result (adjust-array result allocated-length)))
-		 (setf (aref result index)
-		       (apply function row))))
-	(database-dump-result-set result-set database)))))
+    (let ((flatp (and (= columns 1) 
+                      (typecase query-expression 
+                        (string t) 
+                        (sql-query
+                         (slot-value query-expression 'flatp))))))
+      (when result-set
+        (unwind-protect
+             (if rows
+                 ;; We know the row count in advance, so we allocate once
+                 (do ((result
+                       (cmucl-compat:make-sequence-of-type output-type-spec rows))
+                      (row (make-list columns))
+                      (index 0 (1+ index)))
+                     ((not (database-store-next-row result-set database row))
+                      result)
+                   (declare (fixnum index))
+                   (setf (aref result index)
+                         (if flatp 
+                             (apply function row)
+                             (funcall function (copy-list row)))))
+                 ;; Database can't report row count in advance, so we have
+                 ;; to grow and shrink our vector dynamically
+                 (do ((result
+                       (cmucl-compat:make-sequence-of-type output-type-spec 100))
+                      (allocated-length 100)
+                      (row (make-list columns))
+                      (index 0 (1+ index)))
+                     ((not (database-store-next-row result-set database row))
+                      (cmucl-compat:shrink-vector result index))
+                   (declare (fixnum allocated-length index))
+                   (when (>= index allocated-length)
+                     (setq allocated-length (* allocated-length 2)
+                           result (adjust-array result allocated-length)))
+                   (setf (aref result index)
+                         (if flatp 
+                             (apply function row)
+                             (funcall function (copy-list row))))))
+          (database-dump-result-set result-set database))))))
 
 ;;; Row processing macro from CLSQL