X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Floop-extension.lisp;h=4fc421bb56452ecf71af888c32997faed4e64472;hb=a91ef336e5401ba5acbe0cf66447eeae7d4cad50;hp=335a9d234b93a0b5ef37d16c872ab6c8f8840c10;hpb=49db0a8a6a6cde1581d5de0dd3c6822fd505472b;p=clsql.git

diff --git a/base/loop-extension.lisp b/base/loop-extension.lisp
index 335a9d2..4fc421b 100644
--- a/base/loop-extension.lisp
+++ b/base/loop-extension.lisp
@@ -55,11 +55,10 @@
 
     (cond
       ;; Object query resulting in a list of returned object instances
-      #+ignore
-      ((and (consp (first in-phrase))
-	    (consp (second (first in-phrase)))
-	    (eq 'quote (first (second (first in-phrase))))
-	    (symbolp (second (second (first in-phrase)))))
+     ((and (consp (first in-phrase))
+	   (consp (second (first in-phrase)))
+	   (eq 'quote (first (second (first in-phrase))))
+	   (symbolp (second (second (first in-phrase)))))
 
        (let ((result-var (ansi-loop::loop-gentemp
 			      'loop-record-result-))
@@ -69,6 +68,7 @@
 	    (,step-var nil))
 	   ()
 	   ()
+	   ()
 	   (if (null ,result-var)
 	       t
 	       (progn
@@ -160,11 +160,38 @@
 
     (cond
       ;; Object query resulting in a list of returned object instances
-      ((and (consp (car in-phrase))
-	    (consp (second (car in-phrase)))
-	    (eq 'quote (first (second (car in-phrase))))
-	    (symbolp (second (second (car in-phrase)))))
-       (loop-error "object query not yet supported"))
+      ((and (string-equal "select" (symbol-name (car in-phrase)))
+	    (eq 'quote (first (second in-phrase)))
+	    (symbolp (second (second in-phrase))))
+
+       (let ((result-var (gensym "LOOP-RECORD-RESULT-"))
+	     (step-var (gensym "LOOP-RECORD-STEP-")))
+	 (values
+	  t
+	  nil
+	  `(,@(mapcar (lambda (v) `(,v nil)) iter-var)
+	    (,result-var ,in-phrase)
+	    (,step-var nil))
+	  ()
+	  ()
+	  ()
+	  `((if (null ,result-var)
+		t
+		(progn
+		  (setq ,step-var (first ,result-var))
+		  (setq ,result-var (rest ,result-var))
+		  nil)))
+	  `(,iter-var ,step-var)
+	  `((if (null ,result-var)
+		t
+		(progn
+		  (setq ,step-var (first ,result-var))
+		  (setq ,result-var (rest ,result-var))
+		  nil)))
+	   `(,iter-var ,step-var)
+	   ()
+	   ()
+	   )))
       
       ((consp iter-var)
        (let ((query-var (gensym "LOOP-RECORD-"))