X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Fbasic-sql.lisp;fp=base%2Fbasic-sql.lisp;h=b0a2dad2ddc2138189ac64ada417101a55511ee7;hb=1751e5245c270bd1ee854a98dfe6caa665abe34e;hp=86f826755317b9ca1830ed4d1b96703f6d02417c;hpb=68290f0275c3193cd0413fb247a1395486747338;p=clsql.git

diff --git a/base/basic-sql.lisp b/base/basic-sql.lisp
index 86f8267..b0a2dad 100644
--- a/base/basic-sql.lisp
+++ b/base/basic-sql.lisp
@@ -63,47 +63,64 @@ pair."))
 (defmacro do-query (((&rest args) query-expression
 		     &key (database '*default-database*) (result-types nil))
 		    &body body)
-  "Repeatedly executes BODY within a binding of ARGS on the attributes
-of each record resulting from QUERY. The return value is determined by
-the result of executing BODY. The default value of DATABASE is
-*DEFAULT-DATABASE*."
+  "Repeatedly executes BODY within a binding of ARGS on the
+attributes of each record resulting from QUERY-EXPRESSION. The
+return value is determined by the result of executing BODY. The
+default value of DATABASE is *DEFAULT-DATABASE*."
   (let ((result-set (gensym))
 	(columns (gensym))
 	(row (gensym))
 	(db (gensym)))
-    `(let ((,db ,database))
-      (multiple-value-bind (,result-set ,columns)
-          (database-query-result-set ,query-expression ,db
-                                     :full-set nil :result-types ,result-types)
-        (when ,result-set
-          (unwind-protect
-               (do ((,row (make-list ,columns)))
-                   ((not (database-store-next-row ,result-set ,db ,row))
-                    nil)
-                 (destructuring-bind ,args ,row
-                   ,@body))
-            (database-dump-result-set ,result-set ,db)))))))
+    `(if (listp ,query-expression)
+	 ;; Object query 
+         (dolist (,row ,query-expression)
+           (destructuring-bind ,args 
+               ,row
+             ,@body))
+	 ;; Functional query 
+	 (let ((,db ,database))
+	   (multiple-value-bind (,result-set ,columns)
+	       (database-query-result-set ,query-expression ,db
+					  :full-set nil 
+					  :result-types ,result-types)
+	     (when ,result-set
+	       (unwind-protect
+		    (do ((,row (make-list ,columns)))
+			((not (database-store-next-row ,result-set ,db ,row))
+			 nil)
+		      (destructuring-bind ,args ,row
+			,@body))
+		 (database-dump-result-set ,result-set ,db))))))))
 
 (defun map-query (output-type-spec function query-expression
 		  &key (database *default-database*)
 		  (result-types nil))
-  "Map the function over all tuples that are returned by the query in
-query-expression.  The results of the function are collected as
-specified in output-type-spec and returned like in MAP."
-  (macrolet ((type-specifier-atom (type)
-	       `(if (atom ,type) ,type (car ,type))))
-    (case (type-specifier-atom output-type-spec)
-      ((nil) 
-       (map-query-for-effect function query-expression database result-types))
-      (list 
-       (map-query-to-list function query-expression database result-types))
-      ((simple-vector simple-string vector string array simple-array
-	bit-vector simple-bit-vector base-string
-	simple-base-string)
-       (map-query-to-simple output-type-spec function query-expression database result-types))
-      (t
-       (funcall #'map-query (cmucl-compat:result-type-or-lose output-type-spec t)
-              function query-expression :database database :result-types result-types)))))
+  "Map the function over all tuples that are returned by the
+query in QUERY-EXPRESSION. The results of the function are
+collected as specified in OUTPUT-TYPE-SPEC and returned like in
+MAP."
+  (if (listp query-expression)
+      ;; Object query 
+      (map output-type-spec #'(lambda (x) (apply function x)) query-expression)
+      ;; Functional query 
+      (macrolet ((type-specifier-atom (type)
+		   `(if (atom ,type) ,type (car ,type))))
+	(case (type-specifier-atom output-type-spec)
+	  ((nil) 
+	   (map-query-for-effect function query-expression database 
+				 result-types))
+	  (list 
+	   (map-query-to-list function query-expression database result-types))
+	  ((simple-vector simple-string vector string array simple-array
+			  bit-vector simple-bit-vector base-string
+			  simple-base-string)
+	   (map-query-to-simple output-type-spec function query-expression 
+				database result-types))
+	  (t
+	   (funcall #'map-query 
+		    (cmucl-compat:result-type-or-lose output-type-spec t)
+		    function query-expression :database database 
+		    :result-types result-types))))))
 
 (defun map-query-for-effect (function query-expression database result-types)
   (multiple-value-bind (result-set columns)