(defun mappend (fn &rest lsts)
"maps elements in list and finally appends all resulted lists."
(apply #'append (apply #'mapcar fn lsts)))
(defmacro condlet (clauses &body body)
(let ((bodfn (gensym))
(vars (mapcar #'(lambda (v) (cons v (gensym)))
(remove-duplicates
(mapcar #'car
(mappend #'cdr clauses))))))
`(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)))
(print
(macroexpand-1 '(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))))
(`((#:G3210 (Y X Z) (LIST X Y Z)))
(COND
((= 1 2)
(LET (#:G3211 #:G3212 #:G3213)
(LET ((#:G3212 (PRINC 'A)) (#:G3211 (PRINC 'B)))
(#:G3210 #:G3211 #:G3212 #:G3213))))
((= 1 1)
(LET (#:G3211 #:G3212 #:G3213)
(LET ((#:G3211 (PRINC 'C)) (#:G3212 (PRINC 'D)))
(#:G3210 #:G3211 #:G3212 #:G3213))))
(T
(LET (#:G3211 #:G3212 #:G3213)
(LET ((#:G3212 (PRINC 'E)) (#:G3213 (PRINC 'F)))
(#:G3210 #:G3211 #:G3212 #:G3213))))))
(print
(macroexpand '(condlet (((= 1 2) (x 1) (y 1))
((= 1 1) (y 2) (x 2)))
(list x y ))))
(LABELS ((#:G3210 (Y X) (LIST X Y))) ; condlet
(COND ; condlet
((= 1 2) ; condlet-clause
(LET (#:G3211 #:G3212) ; condlet-clause
(LET ((#:G3212 1) (#:G3211 1)) ; condlet-clause, conlet-binds
(#:G3210 #:G3211 #:G3212)))) ; condlet-clause
((= 1 1) ; condlet-clause
(LET (#:G3211 #:G3212) ; condlet-clause
(LET ((#:G3211 2) (#:G3212 2)) ; condlet-clause, condlet-binds
(#:G3210 #:G3211 #:G3212)))))) l condlet-clause
condlet에서 vars는 각 심볼별로 gensym을 만든다. 심볼은 하나만 gensym으로 만들면 되니까 remove-duplicates으로 겹치는 것을 없앰(setf my-val
(mapcar #'cdr
((lambda (clauses)
(mapcar #'(lambda (v) (cons v (gensym)))
(remove-duplicates
(mapcar #'car
(mappend #'cdr clauses)))))
'(((= 1 2) (x (princ 'a)) (y (princ 'b)))
((= 1 1) (y (princ 'c)) (x (princ 'd)))
(t (x (princ 'e)) (z (princ 'f)))))))
((Y . #:G3210) (X . #:G3211) (Z . #:G3212))
1. conlet : 필요한 심볼들에 (gensym)을 적용하고 (cond ...)의 형태를 만든다. ... 안에 넣을 형태를condlet-clause에게 만들도록 위임 (mapcar로 하나씩)label을 붙이기 위해 bodfn에도 gensym을 만듬.
이제부터 중요한 것은 심볼대신 gensym 값들을 가지고 놀아서 매크로를 조작한다. 정말 꽤나 어렵다. 자세히보자.
바인딩이 끝났으면,label을 이용하여 함수를 하나 만든다. 바로 쓰지는 않고 이 label에 붙여진 (gensym)인 bodfn을 다음 함수에 던진다.
이 다음함수(condlet-clause)가 바인딩 후 람다를 실행하는 일까지 한다.
2. condlet-clause (조건절을 만들고 그 뒤에 필요한 심볼의 gensym을 LET에 넣고, 다음 LET에 선택된 심볼에 바인딩될 값을 condlet-binds에서 위임
조건절은 아래와 같다.
,(car cl)필요한 심볼의 gensym값을 모두 넣는다.
(let ,(map #'cdr vars) ...)선택된 심볼에 들어갈 값을 conlet-binds가 하도록 한다.
; vars는 (x #:G1 y #:G2) 형태 ; cl는 (조건절 바인딩) 형태 (let ,(condlet-binds vars cl)그 후 넘겨받은 bodfn(라벨함수)를 실행하고 그 매개변수로 바인딩된 심볼의 (gensym)을 넣는다.
(,bodfn ,@mapcar #'car vars)...
3. condlet-binds : 어떻게 바인딩 되는지 선택하고 그 형태를 만든다.
일단 mapcar를 이용하여 lambda를 실행하는 형태인데, (let ...) 안에 들어가는 리스트를 뱉으면 된다.
아래와 같은 형태다.
((#:G3211 2) (#:G3212 2))먼저 assoc이 뭔지 보자
(setq values '((x . 100) (y . 200) (z . 50))) (print (assoc 'y values)) (Y . 200)
이제 조건절은 썼으니 필요없고 바인딩될 표현식만 필요하다.
mapcar의 두번째 매개변수로 이것들만 들어갈 것이다. 그리고 이것은 lambda에서 bindform이라는 이름으로 들어간다.
(cdr cl)bindform으로 들어온 녀석이 cons인지(리스트인지) 확인한다. 대부분 cons일 것이나 아니면 nil을 뱉는것 같다.
#'(lambda (bindform)
(if (consp bindform)
...
하이라이트다. 여기서는 bindform은 (x 100) 뭐 이런 형태로 이루어져 있을 것이다. 위 예제를 보자.clauses에서 cl하나는 ((= 1 2) (x 1) (y 1)) 이걸 말한다.
여기서 (car cl)은 (= 1 2)
(cdr cl)은 ((x 1) (y 1))이다.
여기서 mapcar 에 람다로 들어오는 값은 각각 (x 1) 와 (y 1)가 따로 들어온다.
그렇다면 (car bindform)은 뭘까
(car '(x 1)) ; x 심볼을 가져옴
(assoc (car bindform) vars) ; 심볼을 가져와서 vars에 해당심볼(x)를 가진 리스트를 찾아낸다.
(cdr (assoc (car bindform) vars) ; (x #:G12) 형태를 받을 것인데 거기서 cdr로 (gensym)값을 해시맵처럼 가져온다.
(cons (cdr (assoc (car bindform) vars)) ; cons로 gensym값과 바인딩될 벨류를 연결하여 리스트를 만든다.
(cdr bindform)))) ; bindform은 (x 1)의 형태로 가져온다. (cdr bindform)은 1
; (#:G1 10) 뭐 이런 형태로 들어간다.
즉 mapcar의 개별 값을 알았으니 전체 값을 돌리면'((#:G1 10) (#:G2 30))이런 형태를 만들어질 것이다.
해석 끝
11.2 The with- Macro
두번째로 컨텍스트를 다루는 타입은 with-를 사용하는 매크로다. 넓은 시야로 보면, 컨텍스트는 하나의 세상 안에 있는 상태들이다. 이 상태들에는 특별한 변수들의 값, 자료구조의 내용물, 리스프 바깥 세상의 상태값들을 말한다.
이런 종류의 컨텍스트를 만들고자 한다면 매크로로 해야 한다. 그렇지 않으면 코드의 body들이 closure로 전부 감싸야 한다.
(with-open-file (s "dump" :direction :output) (princ 99 s))표현식의 평가가 끝나면 "dump"파일은 저절로 닫힌다.
이런 연산자는 매크로로 정의되어야 한다. 왜냐하면 s를 바인딩 하기 때문이기도 하지만, 어짜피 새로운 컨텍스트에서 form(body)가 평가되어야 한다.
일반적으로 컨텍스트를 생성하는 매크로는 코드블록 안에다가 확장을 한 다음, 코드 앞 뒤로 할 일을 더한다.
일반적으로 코드가 body 뒤에 실행되면, 그 목적ㅇ느 시스템의 일관된 상태(실행이전 상태가 대부분일 듯)로 정리하는 것이다.
예를들어 with-open-file은 열어둔 파일을 닫아야 한다. 이런 경우, 일반적으로 unwind-protect로 context-creating매크로가 확장된다.
unwind-protect의 목적은 실행 중에 인터럽트가 발생해도 특정 표현식은 평가되도록 한다.
하나 이상의 매개변수를 받아서 순서대로 평가한다. 만약 모두 잘 진행되면 첫번째 매개변수를 리턴한다.
prog1처럼 prog1과의 차이는 error가 나더라도 나머지 매개변수가 평가되는 것이다.
(setq x 'a)
A
(unwind-protect
(progn (princ "What error?")
(error "This error."))
(setq x 'b))
What error?
>> Error: This error.
자 setq가 실행되기 전에 에러를 던지게 했다.그런데 한번 x가 어떻게 되었나 보자.x Bwith-open-file이 unwind-protect로 확장되기 때문에, 파일은 실행중에 에러가 나도 클로즈가 된다.
컨텍스트생성 매크로들은 대게 특정 앱을 위해 작성되어 진다. 예를 들어 다중원격 DB를 다루는 프로그램을 작성한다 하자.
프로그램은 한번에 한 DB랑 대화하며, 그 DB는 글로벌 *db*에 있다. DB에 연결하여 일을 하기 전에 락을 먼저 걸어야 한다. 그래야 다른 녀석이 동시에 사용할 수 없을 것이다.
만약 디비(db)에서 쿼리(q)에서 값을 원한다면, 아래처럼 짤 것이다.
(let ((temp *db*))
(setq *db* db)
(lock *db*)
(prog1 (eval-query q)
(release *db*)
(setq *db* temp)))
매크로로 이 모든 장부를 숨길 수 있다. 아래 코드들을 보자.; 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))))))
; Combination of macro and function:
(defmacro with-db (db &body body)
(let ((gbod (gensym)))
`(let ((,gbod #'(lambda () ,@body)))
(declare (dynamic-extent ,gbod))
(with-db-fn *db* ,db ,gbod))))
(defun with-db-fn (old-db new-db body)
(unwind-protect
(progn
(setq *db* new-db)
(lock *db*)
(funcall body)) ; with-db-fn은 함수라서 일부러 람다로 보냄
(progn
(release *db*)
(setq *db* old-db))))
복잡성이 올라가면 2번째 방식이 더 실용적이다.CLTL2 COMMON LISP에서, dynamic-extent 선언은 효율적인 할당을 위해 body를 가지는 closure를 허용한다. (CLTL1은 안됨)
우리는 with-db-fn을 실행하는 동안만 closure가 필요하며, 이 선언으로 컴파일러가 스택에 이것을 위한 공간을 할당할 수 있도록 허용함.
이 공간은 가비지 컬렉터가 회수하지 않고 let식이 끝나면 자동으로 회수됨.
11.3 조건평가
조건절에 따라서 평가를 안하고 끝내는 수가 있다( 좋은 것)
(if t
'a
(/ x 0))
0으로 나누는 것은 에러이지만 'a를 뱉으면서 잘 동작하고 끝난다.아래 if3는 if문에서 nil값도 따로 보는 것. if3에서 (nil)로 감싼 이유는 nil은 꽤나 모호한 의미를 가지기 때문이다.
; 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)))))
nif(numeric if)는 숫자에 따라 리턴된다.(mapcar #'(lambda (x) (nif x 'p 'z 'n))
'(0 1 -1))
(Z P N)
그림 11.6은 조건평가를 이용한 다양한 매크로를 보여준다.
매크로 in은 효율적으로 값이 있는지 확인한다. 만약 in을 확장하면 아래처럼 보일 것이다.
(let ((x (foo))) (or (eql x (bar)) (eql x (baz)))) ;; 하지만 member를 이용하면 아래처럼 이뻐찐다. (member (foo) (list (bar) (baz))) ;; 하지만 효율적인가?member는 두 측면에서 비효율적이다.
1 member가 검색하기 위해선 임시 리스트가 필요하다 (만드는 리소스)
2 이 임시 리스트를 만들기 위해 모든 리스트는 평가되어야 한다. 비록 몇 개는 필요 없어도 (필요없는 평가)
(foo)가 (bar)라면 (baz)는 평가할 필요가 없다.
우리는 이거 대신 좀 더 효율적인 추상화를 만들 수 있다. or을 이용하는 효율이면서 member와 같은 추상을 사용하는 매크로!
그것이 in 이다
(defmacro in (obj &rest choices)
(let ((insym (gensym)))
`(let ((,insym ,obj))
(or ,@(mapcar #'(lambda (c) `(eql ,insym ,c))
choices)))))
(defmacro inq (obj &rest args)
`(in ,obj ,@(mapcar #'(lambda (a) `',a)
args)))
(defmacro in-f (fn &rest choices)
(let ((fnsym) (gensym)))
`(let ((,fnsym ,fn))
(or ,@(mapcar #'(lambda (c) `(funcall ,fnsym ,c))
choices)))))
(defmacro >case (expr &rest clauses)
(let ((g (gensym)))
`(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")))))
이제 in을 사용해보자(in (foo) (bar) (baz))
(let ((#:g25 (foo)))
(or (eql #:g25 (bar))
(eql #:g25 (baz))))
inq(in queue)를 보자(inq operator + - *) ;; expands into (in operator '+ '- '*) (member x (list a b) :test #'equal) ; can be duplicated by (in-if #'(lambda (y) (equal x y)) a b) (some #'oddp (list a b)) ; becomes (in-if #'oddp a b)
11.4Iteration 반복
때로 문제는 매개변수가 항상 평가되서가 아니다, 오히려 한번만 평가되는 경우가 문제인 경우가 있다.
표현식의 바디가 반복하려면 매크로 써야함
(defmacro forever (&body body)
`(do ()
(nil)
,@body))
단순한 반복예시로 일단 맛보자; Fig 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)))
이제 본편으로 들어가자. 그림 11.8에서 하나만 잘라서 봐보자(defmacro do-tuples/o (params source &body body)
(if parms
(let ((src (gensym)))
`(prog ((,src ,source))
(mapc #'(lambda ,parms ,@body)
,@(map0-n #'(lambda (n)
`(nthcdr ,n ,src))
(1- (length parms))))))))
(do-tuples/o (x y) '(a b c d)
(princ (list x y)))
(A B)(B C)(C D)
NIL
이렇게 연결되는 것이다. 신기하다. 어덯게 펼쳐지는지 이야기 해보자.; (macroexpand (do-tuples/o (x y) '(a b c d) (princ (list x y)))) (BLOCK NIL (LET ((#:G3215 '(A B C D))) (TAGBODY (MAPC #'(LAMBDA (X Y) (LIST X Y)) (NTHCDR 0 #:G3215) (NTHCDR 1 #:G3215)))))TAGBOY는 라벨같은 거다. GOTO문처럼 이동을 하게 해주는 녀석인데 여기서는 안쓰는 듯하다. 생기기만 하고
NTHCDR은 첫번째 매개변수의 숫자만큼 까고 나머지 cdr 리스트를 리턴한다.
내가 단계단계 연필로 확장해본 걸 아래 적어놓겠다.
; 1
(if '(x y)
(let ((src #:G1))
`(prog ((#:G1 '(a b c d))
(mapc #'(lambda (x y) (princ (list x y)))
,@(map0-n #'(lambda (n) '(nthcdr ,n ,src))
(1- (length parms)))))))
; parms 이 있는 경우
; src (gensym)으로 생성
; 2
(let ((src #:G1))
`(prog ((#:G1 '(a b c d))
(mapc #'(lambda (x y) (princ (list x y)))
,@('(a b c d) '(b c d)))...)
; 3
`(prog ((#:G1 '(a b c d))
...
(princ (list a b))
(princ (list b c))
(princ (list c d))
nil)
정말 매크로를 만드는 작업은 하나의 예술과도 같다.
댓글 없음:
댓글 쓰기