;; Iteration and Macros
;;
;; File:	iteration-and-macros.in
;; Version:	2
;; Author:	walton@das.harvard.edu

;; Sum WITHOUT DO:
;;
(defun sum (m n)
  (cond
   ((> m n) 0)
   (t (+ m (sum (+ m 1) n)))))
--->
SUM

;; Sum with DO:

(defun do-sum (m n)
  (do ((i m (+ i 1))
       (sum 0 (+ sum i)))
      ((> i n) sum)))
--->
DO-SUM

(do-sum 1 3)
--->
6

(sum 1 3)
--->
6

(do-sum 2 5)
--->
14

(sum 2 5)
--->
14



;; Sum with DO compiled into a closure:

(defun compiled-do-sum (m n)

  ;; Hand compilation of:
  ;; (do ((i m (+ i 1))
  ;;      (sum 0 (+ sum i)))
  ;;     ((> i n) sum))
  (let ((loop-f
	 #'(lambda (lf i sum)
		   (cond
		    ((> i n) sum)
		    (t (funcall lf lf
				(+ i 1) (+ sum i)))))))
       (funcall loop-f loop-f m 0)))
--->
COMPILED-DO-SUM

(compiled-do-sum 1 3)
--->
6

(sum 1 3)
--->
6

(compiled-do-sum 2 5)
--->
14

(sum 2 5)
--->
14



;; Backquote notation:

;; In CLISP `... evaluates to a list of the
;; form:
;;
;;	(system::backquote ppp vvv)
;;
;; where vvv is what one would expect from `
;; and ppp is an aid to printing the expression
;; properly.  So to see vvv we define:
;;
(defun whatis (s-expression) (caddr s-expression))
--->
WHATIS

(whatis '`x)
--->
'X

(whatis '`(x . y))
--->
'(X . Y)

(whatis '`(,x . y))
--->
(CONS X 'Y)

(whatis '`(x . ,y))
--->
(CONS 'X Y)

(whatis '`(,x . ,y))
--->
(CONS X Y)



(whatis '`(b c d ,e))
--->
(LIST 'B 'C 'D E)

(whatis '`(+ ,(+ 5 2) ,(- 5 2)))
--->
(LIST '+ (+ 5 2) (- 5 2))

`(+ ,(+ 5 2) ,(- 5 2))
--->
(+ 7 3)



;; The argument to a defmacro can be a pattern,
;; i.e. a list structure whose variables are
;; bound to the corresponding parts of the
;; actual argument list.
;;
(defmacro my-do
  (((v1 i1 n1)         ; (my-do ((v1 i1 n1)
    (v2 i2 n2))        ;         (v2 i2 n2))
   (test result))      ;        (test result))

  `(let ((loop-f
	  #'(lambda (lf ,v1 ,v2)
	      (cond (,test ,result)
		    (t (funcall lf lf ,n1 ,n2))))))
	(funcall loop-f loop-f ,i1 ,i2)))
--->
MY-DO


(macroexpand '(my-do ((i 1 (+ i 1))
		      (sum 0 (+ sum i)))
		     ((> i 100) sum)))
--->
(LET
  ((LOOP-F
      #'(LAMBDA (LF I SUM)
          (COND ((> I 100) SUM)
            (T (FUNCALL LF LF (+ I 1) (+ SUM I)))
  ))    ) )
  (FUNCALL LOOP-F LOOP-F 1 0)
)



(my-do ((i 1 (+ i 1))
	(sum 0 (+ sum i)))
  ((> i 100) sum))
--->
5050

(sum 1 100)
--->
5050



;; Tail Recursiveness

;; (my-add m n) ===> (+ m n) is defined below

;; (random-sum 0) ===> 0
;; (random-sum n) ===> (+ (random 2)
;;                        (random-sum (- n 1)))
;;                     if (> n 0)
;;
;; where n is an integer
;;
(defun random-sum (n)
  (cond ((= n 0) 0)
	((> n 0) (my-add (random 2)
			 (random-sum (- n 1))))))
--->
RANDOM-SUM

;; (tail-recursive-random-sum n)
;;     ===> (tail-recursive-random-sum n 0)
;; (tail-recursive-random-sum 0 result) ===> result
;; (tail-recursive-random-sum n result)
;;     ===> (tail-recursive-random-sum (- n 1)
;;             (+ (random 2) result))
;;          if (> n 0)
;;
;; where n, result are integers
;;
(defun tail-recursive-random-sum
	  (n &optional (result 0))
  (cond ((= n 0) result)
	((> n 0)
	 (tail-recursive-random-sum
	  (- n 1) (my-add (random 2) result)))))
--->
TAIL-RECURSIVE-RANDOM-SUM



;; Compile the above BEFORE MY-ADD is defined, so
;; compiler cannot perform any fancy optimization to
;; make RANDOM-SUM tail recursive when it is not
;; directly so.

(proclaim '(optimize (compilation-speed 0)
		     (debug 1) (speed 3) (safety 3)))
--->
NIL

(compile 'tail-recursive-random-sum)
--->
TAIL-RECURSIVE-RANDOM-SUM

(compile 'random-sum)
--->
RANDOM-SUM

(defun my-add (x y) (+ x y))
--->
MY-ADD

(compile 'my-add)
--->
MY-ADD



(random-sum 1000)
--->
507

(tail-recursive-random-sum 1000)
--->
492

(tail-recursive-random-sum 1000000)
--->
499848


;; The following must be the last thing in the file
;; as it causes an unrecoverable error in some
;; COMMONLISP systems.

(random-sum 1000000)
--->