X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Floop-extension.lisp;h=fb45905ba364af35c4833255b6d64e980fe05757;hb=a4097e19c5157e87b9991549bc44f3ef598aeb90;hp=52144885982b56372fab1fe0451e25845b40d355;hpb=c4da3cfcbb955395d8a556e1f89aadad696302b7;p=clsql.git

diff --git a/base/loop-extension.lisp b/base/loop-extension.lisp
index 5214488..fb45905 100644
--- a/base/loop-extension.lisp
+++ b/base/loop-extension.lisp
@@ -18,30 +18,16 @@
 
 ;;;; MIT-LOOP extension
 
-#+sbcl 
+#+(or allegro sbcl)
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (defpackage #:ansi-loop 
-    (:import-from #:sb-loop 
+    (:import-from #+sbcl #:sb-loop #+allegro #:excl
 		  #:loop-error
 		  #:*loop-epilogue*
 		  #:*loop-ansi-universe* 
 		  #:add-loop-path)))
 
-#+lispworks
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defpackage #:ansi-loop 
-    (:import-from #:loop
-		  #:*epilogue*)))
-
-#+allegro
-(defpackage #:ansi-loop 
-  (:import-from #:excl 
-		#:loop-error
-		#:*loop-epilogue*
-		#:*loop-ansi-universe* 
-		#:add-loop-path))
-
-#+sbcl
+#+(or allegro sbcl)
 (defun ansi-loop::loop-gentemp (&optional (pref 'loopva-))
   (gensym (string pref)))
 
@@ -126,19 +112,19 @@
 			  :preposition-groups '((:of :in) (:from))
 			  :inclusive-permitted nil)
 
-#+lispworks (in-package loop)
-
-#+lispworks
-(defun loop::loop-gentemp (&optional (pref 'loopva-))
-  (gensym (string pref)))
+#+lispworks 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (in-package loop))
 
 #+lispworks
-(cl-user::define-loop-method (record records tuple tuples) ansi-loop::clsql-loop-method (in of from))
+(cl-user::define-loop-method (record records tuple tuples) clsql-loop-method 
+  (in of from))
 
 #+lispworks
-(defun ansi-loop::clsql-loop-method (method-name iter-var iter-var-data-type 
-				     prep-phrases inclusive? allowed-preps 
-				     method-specific-data)
+(defun clsql-loop-method (method-name iter-var iter-var-data-type 
+			  prep-phrases inclusive? allowed-preps 
+			  method-specific-data)
+  (declare (ignore method-name inclusive? allowed-preps method-specific-data))
   (let ((in-phrase nil)
 	(from-phrase nil))
     (loop for (prep . rest) in prep-phrases
@@ -163,11 +149,10 @@
       (setq from-phrase '(clsql-base-sys:*default-database*)))
     (cond
       ((consp iter-var)
-       (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
-	     (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
-	     (result-set-var (ansi-loop::loop-gentemp
-			      'loop-record-result-set-))
-	     (step-var (ansi-loop::loop-gentemp 'loop-record-step-)))
+       (let ((query-var (gensym "LOOP-RECORD-"))
+	     (db-var (gensym "LOOP-RECORD-DATABASE-"))
+	     (result-set-var (gensym "LOOP-RECORD-RESULT-SET-"))
+	     (step-var (gensym "LOOP-RECORD-STEP-")))
 	 (values
 	  t
 	  nil
@@ -194,10 +179,9 @@
 	  ()
 	  ())))
       (t
-       (let ((query-var (ansi-loop::loop-gentemp 'loop-record-))
-	     (db-var (ansi-loop::loop-gentemp 'loop-record-database-))
-	     (result-set-var (ansi-loop::loop-gentemp
-			      'loop-record-result-set-)))
+       (let ((query-var (gensym "LOOP-RECORD-"))
+	     (db-var (gensym "LOOP-RECORD-DATABASE-"))
+	     (result-set-var (gensym "LOOP-RECORD-RESULT-SET-")))
 	 (values
 	  t
 	  nil