2010.02.17 12:24

TAOI - Part2 session 2

이번 이야기는 EVPROGN 에 관한 부분이다. 
앞서 lookup 과 evsetq 보다 생각할 부분이 많은 곳일지도 모른다. 

리스프 1.5는 begin 이나 progn 으로 시작하는 부분이 없었다.
사실 함수형 언어에서는 필요가 없다고 한다. 여러 개의 함수로 값을 주고 받으면 되기 때문이다.

그러나 실제로 프로그래밍 하는 경우에는 시퀀스 식이 있는 편이 낫다.
예전에 내가 IBM 디벨로퍼 웍스에 쓴 글에도 적은 적이 있지만 역시 다 잊어버렸기 때문에 그 글을 다시 찾아 보았다.
(http://www.ibm.com/developerworks/kr/library/s_issue/20081028/)

다음글은 그 중의 일부로  조금 고쳐 놓은 것이다:

시퀀셜 블록

이런 요소들에 대한 명령형 언어의 코드와 람다 식을 비교해 보자. 먼저 명령 여러 개를 처리하는 시퀀셜 블록부터 시작한다. 가장 흔한 코드를 예로 들어 보자. 여기서 s1 등은 문(statement)이다.

begin
        s1;
        s2;
        s3;
end


아니면 C 언어의 {s1 ; s2 ; s3;} 같이 표현할 수도 있겠다. 코드 블록으로는 {s1 ; {s2 ; {s3}}}}처럼 적을 수도 있다. 문장을 이렇게 늘어놓는 것은 일종의 사이드 이펙트를 바라는 것이다. 계산이 일어나거나 대입이 일어나기를, 그것도 순차적으로 일어나기를 원한다. 너무나 일상적인 코딩이어서 전혀 생소하지 않다. 그러나 스킴 같은 함수형 언어에서는 대입이 일어나는 것을 항상 기대하지는 않는다(a=b ; c=b처럼 대입을 일으키는 일, 프린터나 화면에 출력을 하는 것도 일종의 사이드 이펙트다. 계산이 끝나면 항상 무엇인가 변화가 있다).

s1, s2 같은 것은 스킴이나 리스프에서는 람다 식을 계산하는 작업이나 그냥 단순한 식에 해당한다. 그러니 s1; s2를 순차적으로 계산하는 방법은 다음처럼 생각해 볼 수 있다.

((lambda (dummy) s2 ) s1)


인자의 계산이 먼저 일어나므로 s1을 먼저 계산한다. 그리고 이것을 람다 식에 적용하는 것이다. 람다 식은 변수 dummy를 받은 후 s2를 계산한다. 결과적으로 s1을 먼저 계산하고 s2를 계산한다. 이 식을 (block S1 S2)처럼 만들면 (block S1 S2 … Sn)은 (block S1 (block S2 (... (block Sn-1 block Sn) ...))처럼 적을 수 있겠다. 실제 스킴 코드는 (begin s1 s2 s3 ...)처럼 적는다. 별다른 것은 아니지만 한번 생각해볼 필요가 있다.

블록을 일반화한 (lambda (dummy) (lambda (dummy)(…)s3) s2) s1) 같은 패턴의 적용과 계산을 생각할 수 있다. 적용은 순차적으로 일어나며 무엇인가 사이드 이펙트를 기대한다. 마지막 식 Sn을 계산하면 이 값이 리턴값이며 그 앞의 식들은 사이드 이펙트를 제외한다면 결과에 영향이 없다. 그저 계산만 한 것이다. 그래서 예전의 어떤 순수한 함수형 리스프에서는 순차식을 인정하지 않았다. 모든 람다 함수는 조건 식을 제외하면 하나의 람다 식으로 이루어져야 했다. 람다의 인자도 lambda (a)처럼 하나만 받을 수 있도록 제한하려 했다.

시퀀셜 블록을 설명했으니 조금 도약해서 (define bar (lambda (x y) (f x y))) 같은 식을 생각해 보자. 이 식에 인수를 적용하므로 이를테면 (bar foo etc)는 foo와 etc를 앞서 정의한 bar에 적용한다. 이때 foo와 etc가 람다 식이라면 먼저 foo와 etc를 계산한다. foo를 먼저 etc를 나중에 계산한다. 결과적으로 내부의 (f x y)에 다시 대입되기 이전에 이미 한번 계산이 일어난다. 명시하지는 않았지만 foo와 etc를 미리 계산하는 것은 s1과 s2를 계산하는 패턴과 다르지 않다. 원래는 foo의 계산된 값이 x이고 etc의 계산된 값을 y에 적용하기 위한 계산이었으나 이것들이 함수 호출을 일으킨다면 일종의 시퀀셜 블록처럼 작용하는 것을 알 수 있다. 중간에 사이드 이펙트가 있었다면 당연히 무엇인가 변할 것이다. 

(여기에는 물론 전제 조건이 있다. 계산의 순서가 정해져 있으며 사이드이펙트가 있으면 bar에서부터 환경이 변할 수 있고 foo etc 내부에서 어떤 계산 시퀀스가 일어나는 가는 순전히 프로그래머의 책임이다.)

이런 혼동을 피하기 위해 람다 식의 인자를 하나로, 내부의 식도 한 줄로 생각하는 것이 더 명확하게 람다 함수를 표현하는 방법일 수도 있다. 실제로 알론조 처치가 생각한 람다 식은 이런 형태였다고 한다. 하지만 수없이 많은 람다를 만들어내며 프로그래밍하기를 좋아하는 프로그래머는 없었다.

시퀀셜 블록을 이제 하나의 순차적 컨티뉴에이션처럼 생각할 수도 있다. s1의 컨티뉴에이션은 s2이며 s2의 컨티뉴에이션은 s3 ... 이런 식으로 생각할 수 있겠다. 람다 계산법을 발명한 처치 역시 컨티뉴에이션에 대해 잘 알았는데(이름을 짓지는 않았지만) 처치는 두 종류의 컨티뉴에이션을 생각했다. 하나는 지금 예로 든 것과 같은 순차적인 것이고 다른 하나는 조건에 따라 분기하는 컨티뉴에이션이다.


기억을 못해서 다시 보기는 했지만 별다른 내용은 없다.

보충하자면 TAOI 의 {progn wizardry} 에 나오는 대목일 것이다.

결국  PROGN 은 프로그래밍의 편리함을 빼고는 불필요하다, 
applicative order 로 계산하는 언어에서   

우리는 다음과 같은 식을 생각해 볼 수 있겠다. 자세히 들여다보면 결국 위에서 설명한 식이다. 




SICP의 4.1(메타서큘러 인터프리터)에서 같은 부분에 대한 예문은 다음과 같다:

Eval-sequence 는 프로시저 몸체의 식들을 eval을 써서 차례대로 계산한다. 이 식들은 bigin 식 안에 있는 식들이다. 인자는 식들의 시퀀스와 환경이며 식들은 나타나는 순서대로 계산한다. 되돌려주는 값 (value returned)은 마지막식의 값이다. 


(define (eval-sequence exps env)
  (cond ((last-exp? exps) (eval (first-exp exps) env))
        (else (eval (first-exp exps) env)
              (eval-sequence (rest-exps exps) env))))


이 부분의 구성 프로시저는 다음과 같다. 

(define (last-exp? seq) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))

다시 이 프로시저를 다음과 같이 바꾸어 놓을 수 있다.
텍스트만 치환한 내용이다. 
(define (eval-sequence exps env)
  (cond (null? (cdr exps)) (eval (car exps) env))
        (else (eval (car exps) env)
              (eval-sequence (cdr exps) env))))


이번에 사용한 EVPROGN은 다음과 같다. 그다지 깨끗한 코드는 아니다. 

(DEFINE (EVPROGN EXPS ENV HUNOZ)
    (COND ((NULL? (CDR EXPS)) (MCEVAL (CAR EXPS) ENV))
         (#T (EVPROGN (CDR EXPS) ENV (MCEVAL (CAR EXPS) ENV)))))

그러나 이 EVPROGN 은 자신이 PROGN이나 BEGIN 식을 사용하고 있지 않다.  무척 중요한 의미라고 할 수 있다. 위에 나온 SICP 코드를 바꾸어 놓은 버전은 자연스럽게 begin 식이 들어간 것이다.  

TAOI 문서의 Progn Wizardry 에 보면 다음과 같은 보다 더 간단한 EVPROGN 의 코드를 소개하고 있다. 

(DEFINE   (EVPROGN EXPS ENV LASTVAL)
      (COND ((NULL? EXPS) LASTVAL)
         (#T (EVPROGN (CDR EXPS) ENV (MCEVAL (CAR EXPS) ENV)))))

그러면서 이 둘을 비교하기 위한 프로시저로 다음과 같은 테스트 프로시저를 보여준다. 

(DEFINE (PRINTLOOP X)
           (COND ((= X 0)  'BLASTOFF)
                (#T (PROGN (display X)(PRINTLOOP (- X 1))))))

PROGN 식이 있기 때문에 EVPROGN 을 돌리게 된다. 원래의 EVPROGN 과 방금 소개한 EVPROGN 의 차이는 꼬리재귀(Tail Recursion)의 여부다. 간단한 버전의 EVPROGN은 엄밀한 의미에서 꼬리 되돌기가 아니라는 것이다. (LASTVAL 변수가 계속 남아있기 때문이다.)

실제로 디버그로 테스트 해보면 

(driver)

(DEFINE (PRINTLOOP X)
           (COND ((= X 0)  'BLASTOFF)
                (#T (PROGN  X (PRINTLOOP (- X 1))))))
==>

..

exp => {progn x {printloop {- x 1}}}
env => {{{x} 3} {{printloop + - * = eq? cons car cdr null? #t #f} {&labeled {x} {cond {{= x 0} {quote blastoff}} {#t {progn x {printloop {- x 1}}}}}} + - * = eq? cons car cdr null? #t #f}}
...
fun => {&procedure {x} {cond {{= x 0} {quote blastoff}} {#t {progn x {printloop {- x 1}}}}} {{{printloop + - * = eq? cons car cdr null? #t #f} {&labeled {x} {cond {{= x 0} {quote blastoff}} {#t {progn x {printloop {- x 1}}}}}} + - * = eq? cons car cdr null? #t #f}}}
args => {2}
...
fun => {&procedure {x} {cond {{= x 0} {quote blastoff}} {#t {progn x {printloop {- x 1}}}}} {{{printloop + - * = eq? cons car cdr null? #t #f} {&labeled {x} {cond {{= x 0} {quote blastoff}} {#t {progn x {printloop {- x 1}}}}}} + - * = eq? cons car cdr null? #t #f}}}
args => {0}
...
exp => {quote blastoff}
env => {{{x} 0} {{printloop + - * = eq? cons car cdr null? #t #f} {&labeled {x} {cond {{= x 0} {quote blastoff}} {#t {progn x {printloop {- x 1}}}}}} + - * = eq? cons car cdr null? #t #f}}

-->blastoff

이런 식으로 끝나고 나서 다시 몇 번의 루틴을 더 돈다. lastval 을 처리하기 위한 부분이다. 
lastval은 루틴이 수행되는 동안 계속 스택에 쌓인다. lastval의 값을 돌려주기 위한 것이다.

 그러나 아무리 생각해보아도 tail recursion 을 일으키는 프로시저가 더 나을 것이다.  
(이번의 경우에도 나는 손으로 검증해 보아야 했다.) 

이런 과정을  한 번에 건너뛰는 SICP 는 약간의 비약을 하고 있다. 

이것을 한 번에 이해하는 사람들 (아니면 연습문제에서 무언가 잘못된 트랩에 빠진 것을 어렴풋이 느끼더라도 대단한 센스다. )은  별로 없을 지도 모른다.  
 
아무튼 이번 예제의 중요한 결론은 사용자 프로그램의 tail-recursive 하여도 인터프리터가 받쳐주지 않으면 안 된다는 사실이다. 

아무튼 상당히 재미있는 이번 루틴의 소스 코드는 다음과 같다. 
점차 SICP 4.1 과 닮아가는 느낌이다. 
------------------------------------------------
(define (bind vars vals base-env)
  (if (= (length vars) (length vals))
      (cons (cons  vars vals) base-env)
      (if (< (length vars) (length vals))
          (display 'error Too many arguments supplied)
          (display 'error Too few arguments supplied ))))

(define (value name env)
  (value1 name (lookup name env))
    )

(define (value1 name slot )
  ( cond ((eq? slot '&UNBOUND) (display 'errorunbound))
         (else (car slot))
   )
  )

(define (lookup name env)
  (cond ((null? env ) '&UNBOUND)
        (else (lookup1 name (caar env) (cdar env) env))))
  
(define (lookup1 name vars vals env)
      (display vals)
      (display '\n)
  
      (cond ((null? vars)
             (lookup name (cdr env) ))
            
            ((eq? name (car vars)) 
             (COND ((not (list? (CAR VALS))) VALS)
                   ((EQ? (CAAR VALS) '&labeled)  ( list(LIST '&procedure (CADAR VALS) (CADDAR VALS) ENV )) )
                   (#T VALS)))
             
            
            (else (lookup1 name (cdr vars) (cdr vals) env))))
    


(define (driver)
  (driver-loop '(((+ - * = eq? cons car cdr null? #t #f ) + - * = eq? cons car cdr null? #t #f)) '()(display '|LITHP ITH LITHTENING|))
  )

(define (driver-loop env hunoz hukairz)
  (driver-loop-1 env (read)))

(define (driver-loop-1 env form  )
  
  (cond ((not (list? form ))    
         (driver-loop env '() (display (mceval form env))))
        ((eq? (car form ) 'define)
         (driver-loop  env
                       
           (evsetq (CAADR FORM)
                    (LIST '&labeled 
                         (CDADR FORM)
                         (CADDR FORM))
                    env
            )
           
             (display (CAADR FORM))))
   
        
        (#t (driver-loop  env '() (display (mceval form env)))) 
        
     )
 )

 
(define (mceval exp env )
  (cond ((not (list? exp)) ;;atom exp
        ( cond
           ((number? exp ) exp)
           (else  (value exp env))
         ))
     
        ((eq? (car exp) 'quote)  (cadr exp))
        ((eq? (car exp) 'cond) ( evcond (cdr exp)  env ))
       ((eq? (car exp) 'lambda) (list '&procedure (cadr exp) (caddr exp) env) )
       ((EQ? (CAR EXP) 'SETQ)(EVSETQ (CADR EXP) (MCEVAL (CADDR EXP) ENV) ENV))
       ((Eq? (CAR EXP) 'PROGN)(EVPROGN (CDR EXP) ENV '()))

       
        (else
         (mcapply (mceval (car exp)  env)
                (evlis (cdr exp)  env )
             ) )))


(DeFINE (EVSETQ VAR VAL ENV)
         ((LAMBDA (SLOT)
                  (COND ((EQ? SLOT '&UNBOUND)
                         (EV-TOP-LEVEL-SETQ VAR VAL ENV))
                        (#T (set-car! SLOT VAL) env ) ))(LOOKUP VAR ENV)))

(DEFINE (EV-TOP-LEVEL-SETQ VAR VAL ENV)
        (COND ((NULL? (CDR ENV))
               ( set-car! ENV
                              (CONS (CONS VAR (CAAR ENV))
                                    (CONS VAL (CDAR ENV))) ) env)
              (#T (EV-TOP-LEVEL-SETQ VAR VAL (CDR ENV)))))


(DEFINE  ; EVPROGN for non-tail recursive trial as in Fig N2 
  (EVPROGN EXPS ENV LASTVAL)
     (COND ((NULL? EXPS) LASTVAL)(#T (EVPROGN (CDR EXPS) ENV (MCEVAL (CAR EXPS) ENV)))))


;(DEFINE (EVPROGN EXPS ENV HUNOZ)
;    (COND ((NULL? (CDR EXPS)) (MCEVAL (CAR EXPS) ENV))
;         (#T (EVPROGN (CDR EXPS) ENV (MCEVAL (CAR EXPS) ENV)))))

(define (evcond clauses env  )

    (cond ((null? clauses) 'error)
          ((mceval (caar clauses) env )
           (mceval (cadar clauses) env ))
      (else (evcond (cdr clauses) env  ))))

(define (mcapply fun args)
   (display fun)
  
  (cond ((primeop? fun) (primeop-apply  fun args))
        ((eq? (car fun) '&procedure) (mceval (caddr fun) (bind (cadr fun) args (cadddr fun)))) 
        (else 'error-mcapply )  ))

(define (evlis  arglist env  )        ;map evaluator over list

    (cond ((null? arglist) '())

          (else (cons (mceval (car arglist) env )

                      (evlis (cdr arglist) env )))))

(define (primeop? fun)
  (or (eq? fun '+)
      (eq? fun '-)
      (eq? fun '/)
      (eq? fun '*)
       (eq? fun '=)
      (eq? fun 'eq?)
      (eq? fun 'car)
      (eq? fun 'cdr)
      (eq? fun 'cons)
      (eq? fun 'null?)
     
      ;; more
      ))

(define (primeop-apply fun args)
 (cond ( (eq? fun '+ ) (+ (car args) (cadr args)))
       ( (eq? fun '- ) (- (car args) (cadr args)))
       ( (eq? fun '* ) (* (car args) (cadr args)))
       ( (eq? fun '/ ) (/ (car args) (cadr args)))
       ( (eq? fun '= ) (= (car args) (cadr args)))
       ( (eq? fun 'eq? ) (eq? (car args) (cadr args)))
       ( (eq? fun 'cons ) (cons (car args) (cadr args)))
       ( (eq? fun 'car ) (car (car args)))
       ( (eq? fun 'cdr ) (cdr (car args)))
       ( (eq? fun 'null?) (null? (car args)))
      ; ( (eq? fun 'atom ) (* (car args) (cadr args)))
      ; ( (eq? fun '* ) (* (car args) (cadr args)))
        ))


Trackback 0 Comment 0