[on lisp] 11.5 Iteration with Multiple Values (mvdo*)

11.5 Iteration with Multiple Values
fig 11.10을 보자

(defmacro mvdo* (parm-cl test-cl &body body)
  (mvdo-gen parm-cl parm-cl test-cl body))

(defun mvdo-gen (binds rebinds test body)
  (if (null binds)
      (let ((label (gensym)))
        `(prog nil
           ,label
           (if ,(car test)
               (return (progn ,@(cdr test))))
           ,@body
           ,@(mvdo-rebind-gen rebinds)
           (go ,label)))
      (let ((rec (mvdo-gen (cdr binds) rebinds test body)))
        (let ((var/s (caar binds)) (expr (cadar binds)))
          (if (atom var/s)
              `(let ((,var/s ,expr)) ,rec)
              `(multiple-value-bind ,var/s ,expr ,rec))))))

(defun mvdo-rebind-gen (rebinds)
  (cond ((null rebinds) nil)
        ((< (length (car rebinds)) 3)
         (mvdo-rebind-gen (cdr rebinds)))
        (t
         (cons (list (if (atom (caar rebinds))
                         'setq
                         'multiple-value-setq)
                     (caar rebinds)
                     (third (car rebinds)))
               (mvdo-rebind-gen (cdr rebinds))))))

mvdo*를 써보자

(mvdo* ((x 1 (1+ x))
        ((y z) (values 0 0) (values z x)))
       ((> x 5) (list x y z))
  (princ (list x y z)))
(1 0 0)(2 0 2)(3 2 3)(4 3 4)(5 4 5)
(6 4 5)

와... 이렇게 여러개 반복이 멋지게 된단 말이다. 이런 식의 반복은 꽤나 유용하다. 그래픽 프로그램에서는 종종 좌표나 지역 같은 다중 값들을 한번에 다뤄야 한다. 단순한 대화형(반응형) 게임을 작성한다 할때, 목표는 두 물체 사이에 찌그러지지 않도록 하는 것이다. 만약 두 물체가 동시에 당신을 맞추면 지는 것. 혹은 두 물체가 서로를 부신다면 이기는 것. 그림 11.11 에서 이런 게임을 만들 때 mvdo*가 얼마나 유용할지 보여줄 것.

(mvdo* (((px py) (pos player) (move player mx my))
        ((x1 y1) (pos obj1)   (move obj1 (- px x1)
                                         (- py y1)))
        ((x2 y2) (pos obj2)   (move obj2 (- px x2)
                                         (- py y2)))
        ((mx my) (mouse-vector) (mouse-vector))
        (win     nil          (touch obj1 obj2))
        (lose    nil          (and (touch obj1 player)
                                   (touch obj2 player))))
       ((or win lose) (if win 'win 'lose))
   (clear)
   (draw obj1)
   (draw obj2)
   (draw player)) 
; (pos obj) return two values x, y representing the position of obj. ?Initially, the three objects have random positions
; (move obj dx dy) moves the obj depending on its type and the vector(dx,dy). returns two values x,y indicating the new position.
; (mouse-vector) returns two values dx, dy indicating the current movement of the mouse.
; (touch obj1 obj2) returns true if obj1 and obj2 are touching
; (clear) clear the game region
; (draw obj) draws obj at its current position

아래는 코드를 분석해본 것

(defmacro mvdo* (parm-cl test-cl &body body)
  (mvdo-gen parm-cl parm-cl test-cl body))

(defun mvdo-gen (binds rebinds test body)
  (if (null binds) ; binds가 없다면(재귀 다돌면)
      (let ((label (gensym)))
        `(prog nil
           ,label
           (if ,(car test)
               (return (progn ,@(cdr test))))
           ,@body
           ,@(mvdo-rebind-gen rebinds)
           (go ,label)))
      (let ((rec (mvdo-gen (cdr binds) rebinds test body)))  ;; binds가 있다면. (mvdo-gen (cdr binds) rebinds test body)를 rec로 부른다. (재귀할건가봄)
           (let ((var/s (caar binds)) (expr (cadar binds)))  ;; binds의 첫번째의 심볼값을 var/s라 하고 그 옆에 있는 녀석을 expr로 넣는다.(초기값)
          (if (atom var/s)  ; var/s가 하나라면 (다중이 아니라면)
              `(let ((,var/s ,expr)) ,rec) ; (,var/s ,expr) 로 값을 바인딩함 그 후 rec를 실행 (mvdo*는 순서대로 실행되어야함 바인딩이 순서가 있음)
              `(multiple-value-bind ,var/s ,expr ,rec)))))) ; 여러개면 multiple-value-bind를 쓴다.  (multiple-value-bind (...) (...) rec) rec에서 let과 muliple-value-bind가 계속 만들어짐
; 결국 재귀를 하다가 (if (null binds)...) 에 다다르면
; (prog를 쓰고 (return (progn ,@(cdr test)))로 리턴할 값을 리턴함.
; cadar는 cdr후 car한것
; 데모
'(mvdo* ((x 1 (1+ x))
        ((y z) (values 0 0) (values z x)))
       ((> x 5) (list x y z))
   (princ (list x y z)))
))
;(LET ((X 1))
; (MULTIPLE-VALUE-BIND (Y Z) (VALUES 0 0)
;  (PROG NIL #:G3210 (IF (> X 5) (RETURN (PROGN (LIST X Y Z)))) ; PROG NIL(바인딩없음) #:G3210 고투문을 위한 이름
;   (PRINC (LIST X Y Z)) ; ,@body
;   (SETQ X (1+ X))  ; ,@(mvdo-rebind-gen rebinds)
;   (MULTIPLE-VALUE-SETQ (Y Z) (VALUES Z X)) (GO #:G3210))))  ; (go ,label)))


; rebinds가 nil이면 nil
; (< (length (car rebinds)) 3) 길이가 3보다 작으면(2개면 값설정만 3개면 루프돌때마다 업데이트) (mvdo-rebind-ged (cdr rebinds))
; 
(defun mvdo-rebind-gen (rebinds)
  (cond ((null rebinds) nil)
        ((< (length (car rebinds)) 3)
         (mvdo-rebind-gen (cdr rebinds)))
        (t
         (cons (list (if (atom (caar rebinds)) ; 바인딩될 값이 atom이면 setq
                         'setq
                         'multiple-value-setq) ; 여러개면 multiple-value-setq
                     (caar rebinds)  ; caar로 첫번째(현재바인딩문)의 첫번째 빼냄.(심볼)
                     (third (car rebinds))) ; 업데이트문 빼냄.
               (mvdo-rebind-gen (cdr rebinds)))))) ; cdr로 다음타자 재귀로 부름. 마지막에 cons로 합침.
; 데모
(print (macroexpand
        (mvdo-rebind-gen '((x 1 (1+ x))
        ((y z) (values 0 0) (values z x))))))
; ((SETQ X (1+ X)) (MULTIPLE-VALUE-SETQ (Y Z) (VALUES Z X))) 

'(print (caar '((y z) (values 0 0) (values z x))))