r9232: OODML LOOP now works on Lispworks

diff --git a/ChangeLog b/ChangeLog
index 99b060d2c91b365881b6c1ee322b386e88c24e19..22b926276da7089cad33f49472a1207f928ceab2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,4 +1,5 @@
 4 May 2004 Kevin Rosenberg (kevin@rosenberg.net)
 4 May 2004 Kevin Rosenberg (kevin@rosenberg.net)

+       * Version 2.10.10-pre

        * sql/metaclasses.lisp: Properly store specified-type from
        direct-slot-definition and then store translated type in
        effective-slot-definition
        * sql/metaclasses.lisp: Properly store specified-type from
        direct-slot-definition and then store translated type in
        effective-slot-definition


@@ -7,10 +8,10 @@
        * base/basic-sql.lisp: Make :AUTO the default value for
        :RESULT-TYPES for MAP-QUERY and DO-QUERY.
        * sql/objects.lisp: Add bigint type
        * base/basic-sql.lisp: Make :AUTO the default value for
        :RESULT-TYPES for MAP-QUERY and DO-QUERY.
        * sql/objects.lisp: Add bigint type

-       * base/loop.lisp: Add placeholder and error message for object
-       iteration. Use :result-type :auto for result-set. Remove 
+       * base/loop.lisp: Add object iteration. Use :result-type
+       :auto for result-set. Remove 

        duplicate (and non-correct) code for non-list variables by
        duplicate (and non-correct) code for non-list variables by

-       simply making an atom variable into a list.
+       simply making an atom variable into a list. 

        * test/tests-basic.lisp: Add tests for :result-types for
        MAP-QUERY and DO-QUERY
        * test/test-fdml.lisp: Add test for result-types in LOOP
        * test/tests-basic.lisp: Add tests for :result-types for
        MAP-QUERY and DO-QUERY
        * test/test-fdml.lisp: Add test for result-types in LOOP


@@ -18,6 +19,8 @@
        Add test that default :result-types is auto for FDML QUERY.
        * sql/query.lisp: Set default for :result-types to :auto in
        FDML QUERY.
        Add test that default :result-types is auto for FDML QUERY.
        * sql/query.lisp: Set default for :result-types to :auto in
        FDML QUERY.

+       * test/test-oodml.lisp: Enable OO loop iteration test with
+       slight change.

        
 4 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) 
        * Version 2.10.9
        
 4 May 2004 Marcus Pearce (m.t.pearce@city.ac.uk) 
        * Version 2.10.9

diff --git a/TODO b/TODO
index 2a8c417fe5583e4c5662eaca4e54ae49c86148b4..4a25b42f9f8fded6dbf4335e30f7c189b946ec0f 100644 (file)
--- a/TODO
+++ b/TODO
@@ -35,9 +35,6 @@ COMMONSQL SPEC
       o get :target-slot working 
       o implement :retrieval :immediate 
 
       o get :target-slot working 
       o implement :retrieval :immediate 
 

-    LOOP
-      o should work with object queries as well as functional ones 
-

  >> Symbolic SQL syntax 
 
       o Complete sql expressions (see operations.lisp)
  >> Symbolic SQL syntax 
 
       o Complete sql expressions (see operations.lisp)

diff --git a/base/loop-extension.lisp b/base/loop-extension.lisp
index 335a9d234b93a0b5ef37d16c872ab6c8f8840c10..526bafd863c6684af279afa42f9294b052b7c7eb 100644 (file)
--- a/base/loop-extension.lisp
+++ b/base/loop-extension.lisp
@@ -55,9 +55,8 @@
 
     (cond
       ;; Object query resulting in a list of returned object instances
 
     (cond
       ;; Object query resulting in a list of returned object instances

-      #+ignore

       ((and (consp (first in-phrase))
       ((and (consp (first in-phrase))

-           (consp (second (first in-phrase)))
+           (string-equal "select" (symbol-name (caar in-phrase)))

            (eq 'quote (first (second (first in-phrase))))
            (symbolp (second (second (first in-phrase)))))
 
            (eq 'quote (first (second (first in-phrase))))
            (symbolp (second (second (first in-phrase)))))
 


@@ -69,6 +68,7 @@
            (,step-var nil))
           ()
           ()
            (,step-var nil))
           ()
           ()

+          ()

           (if (null ,result-var)
               t
               (progn
           (if (null ,result-var)
               t
               (progn


@@ -160,11 +160,38 @@
 
     (cond
       ;; Object query resulting in a list of returned object instances
 
     (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-"))
       
       ((consp iter-var)
        (let ((query-var (gensym "LOOP-RECORD-"))

diff --git a/tests/test-oodml.lisp b/tests/test-oodml.lisp
index e30e396a130d38435195d1bf0806197cb21fc18e..7e875b26d8f182adcee256ca699364e15b79aa48 100644 (file)
--- a/tests/test-oodml.lisp
+++ b/tests/test-oodml.lisp
@@ -287,13 +287,11 @@
                                            "Lenin"]])
  (("Lenin" "Widgets Inc.")))
 
                                            "Lenin"]])
  (("Lenin" "Widgets Inc.")))
 

-#||

 (deftest :oodml/iteration/3
 (deftest :oodml/iteration/3

-    (loop for (e) being the tuples in 
-          [select 'employee :where [married] :order-by [emplid]]
-          collect (slot-value e 'last-name))
+    (loop for (e) being the records in 
+          (select 'employee :where [married] :order-by [emplid])
+     collect (slot-value e 'last-name))

   ("Lenin" "Stalin" "Trotsky"))
   ("Lenin" "Stalin" "Trotsky"))

-||#

 
 ))
 
 
 ))