[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: loop macro

Okay, now here is a different perspective on the LOOP problem.  I will play
devil's advocate here and claim that the main purpose of LOOP is to
duplicate the functionality of the sequence functions.  Indeed, when
illustrating uses of LOOP we tend to pick as examples things that are single
sequence functions, which only gives me extra confidence that Common Lisp
has captured a useful set of primitive iteration operations in these
sequence functions.  Here follows renderings of Gregor's examples in this
manner.  (I don't mean to pick on Gregor; rather, he has done us the great
service of providing a few examples for discussion, and I'm discussing
them.)

    ;; Return a list of the items in list-of-items 
    ;; which pass the test TEST.
    (iterate ((item in list-of-items))
      (when (test item)
	(collect item)))

(remove-if-not #'test list-of-items)

    ;; Basically FIRSTN
    ;; Get the first 10 items in a list
    (iterate ((item in list)
	      (i from 0 below 10))
      (collect y))

(subseq list 0 10)

    ;; Sort of GETL.
    ;;
    (iterate ((prop on plist by cddr))
      (when (memq (car prop) properties-to-collect)
	(collect prop)))

This one is indeed hard to do with sequence functions (because a
property list is not uniform).  Instead I shall write a DO loop:
    (do ((prop plist (cddr prop))
	 (result '() (if (memq (car prop) properties-to-collect)
	 ----------------
			 (cons prop result)
			 -----      -------
			 result)))
			 --------
	((null prop) (nreverse result)))
		     -----------------
In this case the simple word "collect" certainly has captured a
common pattern of use (the parts underlines above), and so I cannot
deny that the iterate/collect syntax is more concise in this case.


    ;; Return a left hand to match left-hand-to-match
    ;; or error if couldn't find one.
    (iterate ((left in left-hands)
	      (right in right-hands))
      (when (eq left left-to-match)
	(return right))
      (finally (error "Could find a right hand.")))

(let ((pos (position left left-hands :test #'eq)))
  (if pos
      (elt right-hands pos)
      (error "Could find a right hand.")))		;[Sic]


Because of their small size, these examples may not be convincing to
everyone.  As additional evidence, here are some more complex examples of
uses of LOOP, taken from the Symbolics documentation (Volume 2: Reference
Guide to Symbolics-Lisp, March 1985):

Page 213:
	(loop for x in list
	      collect (foo x) into foo-list
	      collect (bar x) into bar-list
	      collect (baz x) into baz-list
	      finally (return (list foo-list bar-list baz-list)))

(list (mapcar #'foo list)
      (mapcar #'bar list)
      (mapcar #'baz list))

Page 217:
	(loop for x in l
	      when (atom x)
		when (memq x *distinguished-symbols*)
		  do (process1 x)
	      else do (process2 x)	;[Sic--indentation bug!]
	      else when (memq (car x) *special-prefixes*)
		     collect (process3 (car x) (cdr x))
		     and do (memorize x)
	      else do (process4 x))

(mapcan #'(lambda (x)
	    (cond ((atom x)
		   (if (memq x *distinguished-symbols*)
		       (process1 x)
		       (process2 x))
		   nil)
		  ((memq (car x) *special-prefixes*)
		   (prog1 (list (process3 (car x) (cdr x))) (memorize x)))
		  (t (process4 x) nil)))
 l)


Finally, here are a few examples taken from actual code.  These first few
are taken from the Symbolics implementation of FORMAT (I hope Symbolics
won't mind my quoting a few lines of code for academic "review purposes").
I'm more or less just going to take the first several loops I come to:


	(LOOP FOR I FROM OLD-FILL-POINTER BELOW NEW-FILL-POINTER
		   DO (ASET #\SP FORMAT-STRING I))

(fill format-string #\sp :start old-fill-pointer :end new-fill-pointer)


	(LOOP FOR I FROM CTL-INDEX BELOW (OR TEM CTL-LENGTH) DO
	      (FUNCALL *FORMAT-OUTPUT* ':TYO (SYS:CL-CHAR-CODE (AREF CTL-STRING I))))

(map nil #'(lambda (x) (funcall *format-output* ':tyo (sys:cl-char-code x)))
     (subseq ctl-string ctl-index (or tem ctl-length)))

	(LOOP FOR X = (ABS ARG) THEN (// X BASE)
	      COUNT T
	      UNTIL (< X BASE))

This isn't operating on sequences, so I will render this as a DO loop:

(do ((x (abs arg) (// x base))
     (n 0 (+ n 1)))
    ((< x base) n))


	(LOOP FOR DIVISOR = (^ BASE (1- NDIGITS)) THEN (// DIVISOR BASE)
	      DO (FUNCALL *FORMAT-OUTPUT* ':TYO (+ (// ARG DIVISOR) #/0))
	      UNTIL (= DIVISOR 1)
	      DO (SETQ ARG (\ ARG DIVISOR))
		 (WHEN (ZEROP (\ (DECF NDIGITS) 3))
		   (FUNCALL *FORMAT-OUTPUT* ':TYO COMMACHAR)))

Again, sequences are not involved here, so I use a DO loop.

(do ((DIVISOR (^ BASE (1- NDIGITS)) (// DIVISOR BASE)))
    (())
  (FUNCALL *FORMAT-OUTPUT* ':TYO (+ (// ARG DIVISOR) #/0))
  (when (= DIVISOR 1) (return))
  (SETQ ARG (\ ARG DIVISOR))
  (WHEN (ZEROP (\ (DECF NDIGITS) 3))
    (FUNCALL *FORMAT-OUTPUT* ':TYO COMMACHAR)))


	(LOOP REPEAT WIDTH
	      DO (SEND *FORMAT-OUTPUT* ':TYO OVERFLOW-CHAR))

(dotimes (j width)
  (declare (ignore j))
  (SEND *FORMAT-OUTPUT* ':TYO OVERFLOW-CHAR))


	(LOOP FOR I FROM 0
	      FOR X IN LIST
	      DO (ASET X ARRAY I))

(replace array x)


Now here are some examples taken from a microcode assembler written at
Thinking Machines:


	(LOOP FOR DELAYED-FUNCTION IN *DELAYED-ASSEMBLY-FUNCTIONS*
	      FOR SYMBOL = (GET-DELAYED-ASSEMBLY-SYMBOL DELAYED-FUNCTION)
	      DO (SETF (SYMEVAL SYMBOL) NIL))

(dolist (delayed-function *delayed-assembly-functions*)
  (setf (symeval (get-delayed-assembly-symbol delayed-function)) nil)

[I don't know why SET was not used there.]


	;; if there were any MMCALLs, they must be removed.
	(SETQ *ALL-MMCALLS* (LOOP FOR CALL-ITEM IN *ALL-MMCALLS*
				  FOR CALLING-LOCATION = (SECOND CALL-ITEM)
				  FOR CALLING-INSTR = (AREF INSTR-FROM-LOC CALLING-LOCATION)
				  WHEN (NOT (<= START-INSTR CALLING-INSTR STOP-INSTR))
				    COLLECT CALL-ITEM))

(setq *all-mmcalls*
      (remove-if-not #'(lambda (call-item)
			 (let* ((calling-location (second call-item))
				(calling-instr (aref instr-from-loc calling-location)))
			        (<= start-instr calling-instr stop-instr)))
		     *all-mmcalls*))

      
	(LOOP FOR INSTR FROM START-INSTR BELOW (1+ STOP-INSTR) DO
	  ;; smash the instruction at this location
	  (SETF (AREF INSTR-AFTER-INLINE-MACROEXPAND INSTR) NIL)
	  (SETF (AREF INSTR-BEFORE-INLINE-MACROEXPAND INSTR) NIL)

(progn (fill instr-after-inline-macroexpand nil :start start-instr :end (1+ stop-instr))
       (fill instr-before-inline-macroexpand nil :start start-instr :end (1+ stop-instr)))


	(LOOP FOR (VARIABLE-NAME TYPE . REST) IN *UC-CS-ELEMENTS*
	      COLLECTING VARIABLE-NAME)

(mapcar #'car *uc-cs-elements*)

[Admittedly the destructuring gives one a nice picture of what's going on.]


In a fair amount of recent programming in Common Lisp, I have found that
extensive use of MAP, REDUCE, and REMOVE-IF eliminates the need for a
lots of explicit loops.  Certainly the code generates some intermediate
list structure that could be eliminated.  I would very much like to see
compilers that can, in certain easy cases, open-code calls to a few of
these sequence functions and jam loops together.  Here are examples of code
originally rendered in that style, along with a translations using LOOP:

(reduce #'union (mapcar #'xapping-exceptions args) :initial-value '())

	(LOOP FOR X IN ARGS UNIONING (XAPPING-EXCEPTIONS X))

	[This assumes I manage to define a new collector UNIONING
	 (not supplied in Symbolics LOOP).]

	(LOOP FOR X IN ARGS
	      FOR RESULT = '() THEN (UNION RESULT (XAPPING-EXCEPTIONS X))
	      FINALLY (RETURN RESULT))


(reduce #'intersection
	(mapcar #'xapping-domain
		(remove-if #'xapping-infinite args)))

	(LOOP FOR X IN ARGS
	      FOR RESULT = T
	      UNLESS (XAPPING-INFINITE X)
		WHEN (EQ RESULT T)
		  DO (SETQ RESULT X)
	        ELSE DO (SETQ RESULT (INTERSECTION RESULT X)))

Can anyone else render these examples more elegantly using LOOP?  I'm not
sure I have demonstrated the point I set out to prove, but I think I have
provided some more interesting examples to discuss.

--Guy