Lisp HUG Maillist Archive

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


Updated at: 2020-12-10 09:01 UTC