;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: loop-extension.lisp
+;;;; Name: loop-extension.lisp
;;;; Purpose: Extensions to the Loop macro for CLSQL
;;;;
;;;; Copyright (c) 2001-2004 Kevin Rosenberg and (c) 1999-2001 Pierre R. Mai
(setq variable (list variable)))
(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)))))
+ ;; object query
+ ((and (consp (first in-phrase))
+ (string-equal "sql-query" (symbol-name (caar 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-))
(step-var (ansi-loop::loop-gentemp 'loop-record-step-)))
`(((,variable nil ,@(and data-type (list data-type)))
- (,result-var ,(first in-phrase))
+ (,result-var (clsql-base:query ,(first in-phrase)))
(,step-var nil))
()
()
+ ()
(if (null ,result-var)
t
(progn
(setq iter-var (list iter-var)))
(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"))
+ ;; object query
+ ((and (consp in-phrase)
+ (string-equal "sql-query" (symbol-name (car in-phrase)))
+ (consp (second 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 (clsql-base:query ,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-"))