LUA for loops (in LISP)

for.lisp

#|
The LUA programming language supports iterators.

The LUA for loop takes some generate function and asks it to
produce a function that can return the next item.

A loop is then entered. The next item is generated. If it
is non-nil, then the body of the loop is called to consume
that item. 

Otherwise, it exit.

The following LISP macro emulates that for command. 
|#
(defmacro for ((item producer) &body consume)
  (let ((step (gensym "STEP"))
	(next (gensym "NEXT"))
	(run  (gensym "RUN")))
  `(let ((,step ,producer))
     (labels ((,next () (funcall ,step))
	      (,run   (,item)
		(when ,item
		  ,@consume
		  (,run (,next)))))
       (,run (,next))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXAMPLE 1: generate a bunch of odd numbers

(defun odds(max) 
  (let ((i 0))
    #'(lambda ()
	(incf i)
	(if (evenp i)
	    (incf i))
	(if (<= i max)
	    i))))

(defun !for1 ()
  (for (item (odds 10))
    (print item)))

#|
(LET ((#:STEP1404 (ODDS 10)))
  (LABELS ((#:NEXT1405 ()
             (FUNCALL #:STEP1404))
           (#:RUN1406 (ITEM)
             (WHEN ITEM (PRINT ITEM) (#:RUN1406 (#:NEXT1405)))))
    (#:RUN1406 (#:NEXT1405))))

CL-USER> (!for1)

1 
3 
5 
7 
9 
NIL
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXAMPLE 2: process all the odd,even items in a list
(defun oddeven (lst)
  (let ((copy (copy-list lst)))
    #'(lambda ()
	(when lst
	  (let ((odd  (pop copy))
		(even (pop copy)))
	    (and odd
		 even
		 (list odd even)))))))

(defun !for2 ()
  (for (pair (oddeven '(tim m toni f lucie f)))
    (print pair)))

#|
(LET ((#:STEP1407 (ODDEVEN '(TIM M TONI F LUCIE F))))
  (LABELS ((#:NEXT1408 ()
             (FUNCALL #:STEP1407))
           (#:RUN1409 (PAIR)
             (WHEN PAIR (PRINT PAIR) (#:RUN1409 (#:NEXT1408)))))
    (#:RUN1409 (#:NEXT1408))))

CL-USER> (!for2)

(TIM M) 
(TONI F) 
(LUCIE F) 
NIL
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXAMPLE 3: fibonacci numbers

(defun fibUpToMax (max)
  (let ((i1 1)
	(i2 1))
    #'(lambda ()
	(when (<= i1 max)
	  (let ((tmp i1))
	    (setf i1 i2)
	    (setf i2 (+ tmp i2))
	    tmp)))))

(defun !for3 ()
  (for (num (fibUpToMax 20))
    (print num)))

#|
(LET ((#:STEP1410 (FIBUPTOMAX 20)))
  (LABELS ((#:NEXT1411 ()
             (FUNCALL #:STEP1410))
           (#:RUN1412 (NUM)
             (WHEN NUM (PRINT NUM) (#:RUN1412 (#:NEXT1411)))))
    (#:RUN1412 (#:NEXT1411))))

CL-USER> (!for3)

1 
1 
2 
3 
5 
8 
13 
NIL
|#

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; EXAMPLE 4:
;             sys admin adds in a delay to your accessing
;             (avoids congestion)

(defun recieve (&key (max 100) (buffer 10))
  (let ((pause 5))
    #'(lambda ()
	(let (out)
	  (dotimes (i buffer)
	    (decf max)
	    (if (>= max 0)
		(push (cpuIntensiveThing) out)))
	  (wait (* (random 1.0) pause))
	  out))))

(defun wait (n)
  (dotimes (i (round n))
    (format t "waiting~a~%" i)))

(defun cpuIntensiveThing ()
  (random 100))
	
(defun !for4 ()
  (for (item (recieve :max 22 :buffer 5))
    (format t "~&received ====>  ~a~%" item)))

#|
(LET ((#:STEP1645 (RECIEVE :MAX 22 :BUFFER 5)))
  (LABELS ((#:NEXT1646 ()
             (FUNCALL #:STEP1645))
           (#:RUN1647 (ITEM)
             (WHEN ITEM
               (FORMAT T "~&received ====>  ~a~%" ITEM)
               (#:RUN1647 (#:NEXT1646)))))
    (#:RUN1647 (#:NEXT1646))))

CL-USER> (load "forall.lisp") (!for4)
waiting0
waiting1
received ====>  (83 61 39 71 17)
waiting0
waiting1
waiting2
waiting3
received ====>  (39 27 6 39 80)
waiting0
waiting1
received ====>  (65 61 41 90 52)
waiting0
waiting1
waiting2
waiting3
received ====>  (43 82 29 51 62)
waiting0
waiting1
waiting2
waiting3
waiting4
received ====>  (81 1)
waiting0
waiting1
waiting2
NIL	    
|#