Extending LOOP under LW
Dear lisp huggers,
I've pretty much completed my port of berkeley-db from
cmucl to LW (yay!), but I don't know how to translate the
following forms:
#+CMU
(defun loop-database-iteration-path (variable data-type pps &key which)
(when (cdr pps)
(ansi-loop::loop-error "Only expecting one prepositional phrase here"))
(unless (member (caar pps) '(:of :in))
(ansi-loop::loop-error "Unknown preposition: ~S." (cadr pps)))
(unless (or (null data-type) (subtypep data-type 'string))
(ansi-loop::loop-error "Invalid DB-entry datatype: ~S." data-type))
(let* ((cursor (ansi-loop::loop-gentemp 'loop-cursor-))
(data-type (if data-type `(or null ,data-type)))
(other (ansi-loop::named-variable (if (eq which 'db-key)
'db-value
'db-key)))
(key (if (eq which 'db-key) variable other))
(datum (if (eq which 'db-key) other variable)))
(multiple-value-bind (txn txn-p)
(ansi-loop::named-variable 'transaction)
(push `(db-close ,cursor) ansi-loop::*loop-epilogue*)
`(((,key nil ,data-type)
(,datum nil ,data-type)
(,cursor (db-cursor ,(cadar pps) ,@(if txn-p
`(:transaction ,txn)))))
()
()
((,datum ,key) (multiple-value-list (db-cursor-get ,cursor :next)))
(null ,key)
()))))
#+CMU
(ansi-loop::add-loop-path '(db-key db-keys)
'loop-database-iteration-path
ansi-loop::*loop-ansi-universe*
:preposition-groups '((:of :in))
:inclusive-permitted nil
:user-data '(:which db-key))
#+CMU
(ansi-loop::add-loop-path '(db-value db-values)
'loop-database-iteration-path
ansi-loop::*loop-ansi-universe*
:preposition-groups '((:of :in))
:inclusive-permitted nil
:user-data '(:which db-value))
The LW package provides the following exported symbols:
LISPWORKS:DEFINE-LOOP-MACRO -- macro
LISPWORKS:DEFINE-LOOP-METHOD -- macro
But they are not documented. This is obviously not a big deal, but
it would be nice to provide the same nice extension. Since LW
extends LOOP for common SQL, I'm sure there's a straightforward
way of doing this.
Help anyone?
--
Alain Picard
Memetrics