Revert "Rewriting db-fetch-query-results"
authorNathan Bird <nathan@acceleration.net>
Sat, 28 Feb 2009 20:38:18 +0000 (15:38 -0500)
committerNathan Bird <nathan@acceleration.net>
Sat, 28 Feb 2009 20:38:18 +0000 (15:38 -0500)
Was a neat idea, but used more memory.
This reverts commit b420af1faece44169b08ab4bdf3a98833c32e896.

db-odbc/odbc-dbi.lisp

index 07bfedf28c5c117900993fc51de92c53fd74cdcc..58ef2d729a78d24bb086e6a065d1726de9b7338c 100644 (file)
@@ -309,38 +309,30 @@ the query against." ))
     (with-slots (column-count column-data-ptrs column-c-types column-sql-types
                  column-out-len-ptrs column-precisions hstmt computed-result-types)
         query
-      (labels
-         ((create-column-fetcher (result-type data-ptr c-type sql-type out-len-ptr precision column-nr)
-            (lambda ()
-              (cond ((< 0 precision (query-width query))
-                     (read-data data-ptr c-type sql-type out-len-ptr result-type))
-                    ((zerop (get-cast-long out-len-ptr))
-                     nil)
-                    (t
-                     (read-data-in-chunks hstmt column-nr data-ptr c-type sql-type
-                                          out-len-ptr result-type))))))
-       (let ((fetchers (make-array column-count :fill-pointer 0 :element-type 'function)))
-         ;;; Map across the columns, creating a set of fetch functions
-         (loop for result-type across computed-result-types
-               for data-ptr across column-data-ptrs
-               for c-type across column-c-types
-               for sql-type across column-sql-types
-               for out-len-ptr across column-out-len-ptrs
-               for precision across column-precisions
-               for column-nr from 0 ; column count is zero based in lisp
-               do
-            (vector-push (create-column-fetcher result-type data-ptr c-type sql-type
-                                out-len-ptr precision column-nr)
-                   fetchers))
-         ;; keep fetching rows until we meet the count parameter,
-         ;; or the %sql-fetch says we're done.
-         (loop for i from 0
-               until (or (and count (= i count))
-                         (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND))
-               ;;collect the results of the fetch functions to make a row.
-               collect (map 'list #'funcall fetchers) into rows
-               finally (return (values rows query i))
-               ))))))
+      (let* ((rows-fetched 0)
+             (rows
+              (loop for i from 0
+                  until (or (and count (= i count))
+                            (= (%sql-fetch hstmt) odbc::$SQL_NO_DATA_FOUND))
+                  collect
+                    (loop for result-type across computed-result-types
+                        for data-ptr across column-data-ptrs
+                        for c-type across column-c-types
+                        for sql-type across column-sql-types
+                        for out-len-ptr across column-out-len-ptrs
+                        for precision across column-precisions
+                        for j from 0    ; column count is zero based in lisp
+                        collect
+                          (progn
+                            (incf rows-fetched)
+                            (cond ((< 0 precision (query-width query))
+                                   (read-data data-ptr c-type sql-type out-len-ptr result-type))
+                                  ((zerop (get-cast-long out-len-ptr))
+                              nil)
+                                  (t
+                                   (read-data-in-chunks hstmt j data-ptr c-type sql-type
+                                                        out-len-ptr result-type))))))))
+        (values rows query rows-fetched)))))
 
 (defun db-query (database query-expression &key result-types width)
   (let ((free-query (get-free-query database)))