2019년 9월 1일 일요일

[on lisp] 11 Classic Macros


11.1 Creating Context
Context here has two senses. One sort of context is a lexical environment.
The let special form creates a new lexical environment; the expressions in the body of a let will be evaluated in an environment which may contain new variables.

If x is set to a at the toplevel, then
(let ((x 'b)) (list x))
with nonetheless return (b), because the call to list will be made in an environment containing a new x, whose value is b.

; Fig 11.1 : Macro implementations of let.
; let 만들어보자.
; 1 binds는 바인딩 되는 리스트 body는 이제 표현식
; 2 mapcar로 binds에서 (car x)로 키 값만 가져온다.
; 2.1 cons가 아니면 x로 
; 2.2 그리고 그것은 매개변수에 들어간다. (lambda 매개변수 ..)
; 2.3 body를 ,@body로 리스트를 벗긴다.

; 3 이제 람다 안에 binds 안에 값을 넣는다.
; 3.1 mapcar로 binds에서 (cdr x)로 밸류만 가져온다.
; 3.2 cons가 아니면 nil로 바인딩
(defmacro our-let (binds &body body)
  `((lambda ,(mapcar #'(lambda (x)
                         (if (consp x) (car x) x))
      binds)
    ,@body)
  ,@(mapcar #'(lambda (x)
                 (if (consp x) (cadr x) nil))
      binds)))
보면 알겟지만, let은 매크로 안에서 lambda에서 만든다.
(our-let ((x 1) (y 2))
  (+ x y))
;; 아래로 확장
((lambda (x y) (+ x y)) 1 2)

그림 11.2는 lexical 환경을 만들어서 바인딩하는 3개의 새로운 매크로를 제공한다.
; Fig 11.2 : Macros which bind variables.
(defmacro when-bind ((var expr) &body body)
  `(let ((,var ,expr))
     (when ,var
    ,@body)))

(defmacro when-bind* (binds &body body)
  (if (null binds)
      `(progn ,@body)
   `(let (,(car binds))
      (if ,(caar binds)
       (when-bind* ,(cdr binds) ,@body)))))

(defmacro with-gensyms (syms &body body)
  `(let ,(mapcar #'(lambda (s)
                     `(,s (gensym)))
     syms)
  ,@body)) 
when-bind는 섹션 7.5에서 리스트 파라미터 구조분해로 쓰임. 그러므로 이 매크로는 94페이지에서 이미 설명이 됨
(when-bind (input (get-user-input))
  (process input))
;; expand
(let ((input (get-user-input)))
  (when input
    (process input)))
더 나아가서 when-bind*는 symbol expression(바인딩 될 심볼과 함수)쌍의 리스트를 받는다. -- let의 첫번째 매개변수와 같다.
If any expression returns nil, the whole when-bind* expression returns nil.
이중에 하나라도 nil을 뱉으면 when-bind* 모두 nil임. nil 아니면 body가 평가되게 된다. 그리고 각 symbol들은 let*으로 묶인다.
(when-bind* ((x (find-if #'consp '(a (1 2) b)))
             (y (find-if #'oddp x)))
  (+ y 10))
11
마지막으로 with-gensyms 매크로다. 매크로를 작성할 때 쓰이는 녀석.
많은 매크로들이 gensyms를 생성하는 것으로 시작한다.
종종 이게 많을 때가 있다. page 115에 with-redraw는 5개나 gensym로 만든다
(defmacro with-redraw ((var objs &body body)
  (let ((gob (gensym))
        (x0 (gensym)) (y0 (gensym))
        (x1 (gensym)) (y1 (gensym)))
  ...))
;; 이제 이렇게
(defmacro with-redraw ((var objs) &body body)
  (with-gensyms (gob x0 y0 x1 y1)
    ...))

만약 변수들을 바인딩하려할 때, 조건절에 따라서 다르게 평가를 한다면?
let안에 조건절을 사용하자.

하지만 반대로는? 조건에 따라서 바인딩이 달라져야 한다면
(defmacro condlet (clauses &body body)
  (let ((bodfn (gensym))
        (vars (mapcar #'(lambda (v) (cons v (gensym)))
                      (remove-duplicates
                        (mapcar #'car
                                (mappend #'cdr caluses))))))
    '(labels ((,bodfn ,(mapcar #'car vars)
                 ,@body))
       (cond ,@(mapcar #'(lambda (cl) 
                           (condlet-clause vars cl bodfn))
                       clauses)))))

(defun condlet-clause (vars cl bodfn)
  `(,(car cl) (let ,(mapcar #'cdr vars)
                (let ,(condlet-binds vars cl)
                  (,bodfn ,@(mapcar #'cdr vars))))))

(defun condlet-binds (vars cl)
  (mapcar #'(lambda (bindform)
              (if (consp bindform)
                  (cons (cdr (assoc (car bindform) vars))
                        (cdr bindform))))
          (cdr cl)))
그림 11.3이 그런경우를 보여주는 것이다.
(condlet (((= 1 2) (x (princ 'a)) (y (princ 'b)))
          ((= 1 1) (y (princ 'c)) (x (princ 'd)))
          (t       (x (princ 'e)) (z (princ 'f))))
  (list x y z))
CD
(D C NIL)

11.2 The with- Macro
with-형태의 매크로를 만들어서 컨텍스트를 생성한다.
(with-open-file (s "dump" :direction :output)
  (princ 99 s))
이러면 저절로 "dump"파일을 닫히고 99가 써있게 될 것이다.
; pure macro
(defmacro with-db (db &body body)
  (let ((temp (gensym))
    `(let ((,temp *db*))
       (unwind-protect
         (progn
           (setq *db* ,db)
           (lock *db)
           ,@body)
         (progn
           (release *db*)
           (setq *db* ,temp))))))
; with function
(defmacro with-db (db &body body)
  (let ((gbod (gensym)))
    `(let ((,gbod #'(lambda () ,@body)))
       (declare (dynamic-extent ,gbod))
       (with-db-fn *db* ,db ,good))))

(defun with-db-fn (old-db new-db body)
  (unwind-protect
    (progn
      (setq *db* new-db)
      (lock *db*)
      (funcall body))
    (progn
      (release *db*)
      (setq *db* old-db))))
다른 매크로도 보자.
; Fig 11.5: Macros for conditional evaluation.
(defmacro if3 (test t-case nil-case ?-case)
  `(case ,test
     ((nil) ,nil-case)
     (?     ,?-case)
     (t     ,t-case)))

(defmacro nif (expr pos zero neg)
  (let ((g (gensym)))
    `(let ((,g ,expr))
       (cond ((plusp ,g) ,pos)
             ((zerop ,g) ,zero)
             (t ,neg)))))

11.3 Conditional Evaluation 조건평가
;; fig 11.6 : Macros for conditional evaluation.
(defmacro in (obj &rest choices)
  (let ((insym (gensym)))
    `(let ((,insyn ,obj))
       (or ,@(mapcar #'(lambda (c) `(eql ,insym ,c))
                     choices)))))

(defmacro inq (obj &rest args)
  `(in ,obj ,@(mapcar #'(lambda (a) '' ,a)
                      args)))

(defmacro in-if (fn &rest choices)
  (let ((fnsym (gensym)))
    `(let ((,fnsym ,fn))
       (or ,@(mapcar #'(lambda (c)
                         `(funcall ,fnsym ,c))
                     choices)))))

(defmacro >case (expr &rest clauses)
  (let ((g (gensy)))
    `(let ((,g ,expr))
       (cond ,@(mapcar #'(lambda (cl) (>casex g cl))
                       clauses)))))

(defun >casex (g cl)
  (let ((key (car cl)) (rest (cdr cl)))
     (cond ((consp key) `((in ,g ,@key) ,@rest))
           ((inq key t otherwise) `(t ,@rest))
           (t (error "bad >case clause")))))

11.4 Iteration 반복
; 11.7 : Simple iteration macros.
(defmacro while (test &body body)
  `(do ()
       ((not ,test))
      ,@body))

(defmacro till (test &body body)
  `(do ()
       (,test)
     ,@body))

(defmacro for ((var start stop) &body body)
  (let ((gstop (gensym)))
    `(do ((,var ,start (1+ ,var))
          (,gstop ,stop))
         ((> ,var ,gstop))
       ,@body)))

댓글 없음:

댓글 쓰기