X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=base%2Floop-extension.lisp;h=0eba251c5c2fb8d29d79dacc9bdc765d88f4a028;hb=e5744a78271044484b3399d4fc1d55b3e8808784;hp=76010e41bcb98e0813b92163ab1a0451d8d7b8e4;hpb=41b951fca5ef48b594ca316cf1253b4d1192a045;p=clsql.git diff --git a/base/loop-extension.lisp b/base/loop-extension.lisp index 76010e4..0eba251 100644 --- a/base/loop-extension.lisp +++ b/base/loop-extension.lisp @@ -18,37 +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 -(eval-when (:compile-toplevel :load-toplevel :execute) - (unless (find-package '#:ansi-loop) - (let ((excl::*enable-package-locked-errors* nil)) - (rename-package '#:excl '#:excl - (cons '#:ansi-loop - (package-nicknames (find-package '#:excl))))))) - -#+lispworks -(eval-when (:compile-toplevel :load-toplevel :execute) - (unless (find-package '#:ansi-loop) - (rename-package '#:loop '#:loop - (cons '#:ansi-loop - (package-nicknames (find-package '#:loop)))))) - -#+(or sbcl lispworks) +#+(or allegro sbcl) (defun ansi-loop::loop-gentemp (&optional (pref 'loopva-)) (gensym (string pref))) @@ -136,12 +115,13 @@ #+lispworks (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) (let ((in-phrase nil) (from-phrase nil)) (loop for (prep . rest) in prep-phrases @@ -166,11 +146,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 @@ -197,10 +176,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