2009.03.01 22:01

한태숙교수님 -프로그래밍의 이해 - 2002 가을학기

아마도 이해를 돕기위해 sicp의 1판의 소스코드를 들고 나온 것으로 보이는 한태숙 교수님의 자료 일부입니다. sicp 7a 비디오 렉처에 나오는 코드와 거의 같습니다.

http://ropas.snu.ac.kr/~kwang/4190.210/han/Class15.ppt  에 있던 글로 아마 이광근 교수님이 강의자료의 일부로 올려 놓은 것으로 보입니다.  


메타서큘러 인터프리터가 너무 쉽다고 실망하지는 마세요. 몇가지 복잡한 부분들은 충분히 어렵고 도전적이며 대답없는 질문으로 이어집니다.  일단 taoi를  읽고 제가 고치고 있는 코드가 수행가능해지면 돌려보면서 도전해보세요. 

 

CS220 
Programming Principles
 

프로그래밍의 이해       2002 가을학기

Class 15: Meta-Circular Evaluator

  태숙

  

2  

Metacircular Evaluator 

  • Implementing Lisp
    • Interpreter : implemented language - Lisp
    • Evaluator itself is a program
      • Implementing language - Lisp
 An evaluator of a language that is implemented with the same language is said to be metacircular.   

3  

Evaluation Model of Lisp 

  • Environment model of Chapter 3
  • Evaluation Cycle
    • Evaluate combination : evaluate subexpressions and apply the value of the operator subexpression to the values of the operand subexpressions
    • Appy a procedure to a set of arguments: evaluate the body of the procedure in a new environment. To construct the environment, extend the environment part of the procedure object by a frame in which the formal parameters of the procedure are bound to the arguments.

4.  

Recursive Evaluation of Expressions 

  • Expressions are eventually reduced to
    • a symbol : look up value in the environment
    • primitive procedure : applied directly
  • Role of evaluator given primitive operator:

    The evaluator

    • enables us to deal with nested expressions
    • allows us to use variables
    • allows us to define compound procedures
    • provides the special forms

5  

;;; a meta-circular evaluator which can evaluate itself. 

(define mc-eval

  (lambda (exp env)

    (cond ((number? exp) exp)              ;base-case

          ((symbol? exp) (lookup exp env)) ;base case

          ((eq? (car exp) 'quote)

           (car (cdr exp))) ;special forms

          ((eq? (car exp) 'cond)

           (evcond (cdr exp) env))

          ((eq? (car exp) 'begin)

           (evseq (cdr exp) env))

          ((eq? (car exp) 'lambda)

           (list 'proc (cdr exp) env))

          ((eq? (car exp) 'define)

           (evdefine (cdr exp) env))

          (else (mc-apply (mc-eval (car exp) env)

                          (evlist (cdr exp) env))))))

 
 
 
 
 

6  

(define mc-apply

  (lambda (fun args)

    (cond ((not (pair? fun))

           (apply fun args))   ;ground out 

          ((eq? (car fun) 'proc)

           (mc-eval (car (cdr (car (cdr fun))))

                                       ;procedure body

                    (bind (car (car (cdr fun)))

                                       ;formal params

                          args                  

                                       ;supplied args

                          (car (cdr (cdr fun))))))

                                       ;saved env 

          (else (error '"Unknown function")))))

 
 
 
 
 

7  

(define evlist

  (lambda (lst env)        ;map evaluator over list

    (cond ((null? lst) '())

          (else (cons (mc-eval (car lst) env)

                      (evlist (cdr lst) env)))))) 
 

(define evcond

  (lambda (clauses env)

    (cond ((null? clauses) '())

          ((eq? 'else (car (car clauses)))

           (evseq (cdr (car clauses)) env))

          ((mc-eval (car (car clauses)) env)

           (evseq (cdr (car clauses)) env))

          (else (evcond (cdr clauses) env)))))

 
 
 
 
 

8  

(define evseq

  (lambda (clauses env)

    (cond ((null? (cdr clauses))

           (mc-eval (car clauses) env))

          (else (mc-eval (car clauses) env)

                (evseq (cdr clauses) env))))) 
 

(define evdefine

  (lambda (body env)     ;mutate the first frame

    (begin (set-cdr! (car env)

                     (cons (cons (car body)

                                 (mc-eval (car (cdr body))

                                          env))

                           (cdr (car env))))

           (car body))))

 
 
 
 
 

9  

(define bind

  (lambda (params values env) ;add a new frame

    (cons (cons 'frame

                (make-frame-body params values)) env))) 

(define make-frame-body

  (lambda (params values) ;frame body is an association

                          ;                 list

    (cond ((null? params)

           (cond ((null? values) '())

                 (else (error

                         '"Too many values supplied"))))

          ((null? values)

           (error '"Too few values supplied"))

          (else (cons (cons (car params) (car values))

                      (make-frame-body (cdr params)

                                       (cdr values)))))))

 
 
 
 
 

10  

(define lookup

  (lambda (var env)

    (cond ((null? env)

           (error '"Unbound variable" var))

                                ;not in any frames

          (else ((lambda (binding)

                   (cond ((null? binding)

                                    ;check each frame

                          (lookup var (cdr env)))

                                    ;in turn

                         (else (cdr binding))))

                                    ;(<varname>.<value>)

                 (find-binding var (cdr (car env)))))))) 

(define find-binding

  (lambda (var frame-body) ;this is just assq

    (cond ((null? frame-body) '())

          ((eq? var (car (car frame-body)))

           (car frame-body))

          (else (find-binding var (cdr frame-body))))))

 
 
 
 
 

11  

(define global-env

  (list (list 'frame

              (cons '+ +) (cons '- -) (cons '= =)

              (cons '* *) (cons 'car car)

              (cons 'cdr cdr) (cons 'cons cons)

              (cons 'list list)

              (cons 'set-car! set-car!)

              (cons 'set-cdr! set-cdr!)

              (cons 'null? null?) (cons 'eq? eq?)

              (cons 'pair? pair?) (cons 'not not)

              (cons 'number? number?)

              (cons 'symbol? symbol?)

              (cons 'error error)

              (cons 'apply apply)))) 

 
 
 
 
 

12  

Abstract-Syntax Evaluator 

  • Eval is structured as a case analysis of the syntactic type of the expression to be evaluated.
  • To make the evaluator general, we will use data abstraction for the syntax representation.
  • Each type of expression has a predicate that tests for it and an abstract means for selecting its part.
 
 
 
 
 

13  

Abstract Syntax (I) 

  • Primitive expressions
    • Self-evaluating expressions : numbers
    • Variables : look up its value in the environment
  • Special forms
    • Quote : returns the expression itself (its argument)
    • Assignment : eval arguments(new value) recursively and modify the environment
    • If : evaluate predicate and evaluate consequence or alternative
    • Lambda : make closure
 
 
 
 
 

14  

Abstract Syntax (II) 

    • Begin : evaluate sequence of expression in order
    • Case : transform into a nest of if expressions and then evalute
  • Combinations
    • Procedure application : recursively evaluate the operator and the operands of the combination. Call apply with resulting procedure and arguments as the arguements for  the procedure apply
 
 
 
 
 

15  

;; The Core Evaluator

(define (eval exp env)

  (cond ((self-evaluating? exp) exp)

        ((variable? exp) (lookup-variable-value exp env))   

        ((quoted? exp) (text-of-quotation exp))

        ((assignment? exp) (eval-assignment exp env))

        ((definition? exp) (eval-definition exp env))

        ((if? exp) (eval-if exp env))

        ((lambda? exp)

         (make-procedure (lambda-parameters exp)

                         (lambda-body exp)

                         env))

        ((begin? exp) (eval-sequence (begin-actions exp) env))

        ((cond? exp) (eval (cond->if exp) env))

        ((application? exp)

         (apply (eval (operator exp) env)

                (list-of-values (operands exp) env)))

        (else (error "Unknown expression type -- EVAL" exp))))

 
 
 
 
 

16  

APPLY 

(define (apply procedure arguments)

  (cond ((primitive-procedure? procedure)

         (apply-primitive-procedure procedure arguments))

        ((compound-procedure? procedure)

         (eval-sequence

          (procedure-body procedure)

          (extend-environment

                  (procedure-parameters procedure)

                  arguments

                  (procedure-environment procedure))))

        (else (error

                  "Unknown procedure type -- APPLY”

                   procedure))))

 
 
 
 
 

17  

Procedure Arguments 

(define (list-of-values exps env)

  (if (no-operands? exps)

      '()

      (cons (eval (first-operand exps) env)

            (list-of-values (rest-operands exps) env)))) 

Takes the operands of the expression

and returns a list of corresponding values

 
 
 
 
 

18  

Conditionals 

(define (eval-if exp env)

  (if (true? (eval (if-predicate exp) env))

      (eval (if-consequent exp) env)

      (eval (if-alternative exp) env))) 

Sequences 

(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)))) 

Note: if-expression is evaluated in the implemented language, so

  yields a valued in that language. true? translate it into value of

implementing language for if

 
 
 
 
 

19  

Assignments and Definitions 

(define (eval-assignment exp env)

  (set-variable-value! (assignment-variable exp)

                       (eval (assignment-value exp) exp)

                       env)

   ’ok) 
 

(define (eval-definition exp env)

  (define-variable! (definition-variable exp)

                    (eval (definition-value exp) env)

                    env)

  ’ok) 

Note: return value ’ok is set to arbitrary value. It is implementation

          dependent, and we choose ’ok  in this case.

 
 
 
 
 

20  

Representing Expressions 

  • Syntax of the language being evaluated is determined solely by the procedures that classify and extract pieces of expressions
    • Abstraction of semantics from syntax
    • ex: (+ a b) === (a + b)
 
 
 
 
 

21  

Representing Expressions 

; Self-evaluating items - numbers and strings

(define (self-evaluating? exp)

  (or (number? exp) (string? exp))) 

; variables are represented by symbol

(define (variable? exp) (symbol? exp)) 

;Quotations: (quote <text-of-quot>)

(define (quoted? exp)

     (tagged-list? exp 'quote))

(define (text-of-quotation exp) (cadr exp)) 

(define (tagged-list? exp tag)

  (and (pair? exp) (eq? (car exp) tag)))

 
 
 
 
 

22  

Assignment Statement 

;assignment : (set! <var> <value>)

(define (assignment? exp)

    (tagged-list? exp 'set!)) 

(define (assignment-variable exp) (cadr exp))

(define (assignment-value exp) (caddr exp)) 
 

;definitions :

;  (define <var> <value>)

;  (define (<var> <param1> ...<paramn>)

;          <body>)

;  (define <var>

;      (lambda (<param1> ...<paramn>)

;              <body>))

 
 
 
 
 

23  

Definition Statements 

(define (definition? exp)

   (tagged-list? exp 'define)) 

(define (definition-variable exp)

  (if (symbol? (cadr exp))

      (cadr exp)

      (caadr exp))) 

(define (definition-value exp)

  (if (symbol? (cadr exp))

      (caddr exp)

      (make-lambda (cdadr exp)  ; formal params

                   (cddr exp)))); body

 
 
 
 
 

24  

Lambda Expressions 

; lambda expressions :

;     (lambda (<params>) <body>) 

(define (lambda? exp)

    (tagged-list? exp 'lambda)) 

(define (lambda-parameters lambda-exp)

   (cadr lambda-exp)) 

(define (lambda-body lambda-exp)

   (cddr lambda-exp)) 

(define (make-lambda parms body)

   (cons 'lambda (cons parms body)))

 
 
 
 
 

25  

Conditionals 

; conditionals :

;   (if <pred> <consequence> <alternative>)

;   (if <pred> <consequence>) 

(define (if? exp) (tagged-list? exp 'if)) 

(define (if-predicate exp) (cadr exp))

(define (if-consequent exp) (caddr exp))

(define (if-alternative exp)

  (if (not (null? (cdddr exp)))

      (cadddr exp)

      'false))

; constructor for if : cond->if

(define (make-if pred conseq alt)

  (list 'if pred conseq alt))

 
 
 
 
 

26  

Begin statements 

; begin : (begin <expr1> <expr2> ...<exprn>) 

(define (begin? exp) (tagged-list? exp 'begin))

(define (begin-actions exp) (cdr exp)) 

(define (last-exp? seq) (null? (cdr seq)))

(define (first-exp seq) (car seq))

(define (rest-exps seq) (cdr seq)) 

;a constructor sequence->exp for use by cond->if

; transform a sequence into a single expression

(define (sequence->exp seq)

  (cond ((null? seq) seq)

        ((last-exp? seq) (first-exp seq))

        (else (make-begin seq))))

(define (make-begin exp) (cons 'begin exp))

 
 
 
 
 

27  

Procedure Application 

; procedure application:

; ( <operator> <operand 1> ....<operand n>) 

(define (application? exp) (pair? exp)) 

(define (operator exp) (car exp))

(define (operands exp) (cdr exp)) 

(define (no-operands? args) (null? args))

(define (first-operand args) (car args))

(define (rest-operands args) (cdr args))

 
 
 
 
 

28  

Derived Expressions 

;implemented with other special forms

; example : cond with if

; (cond (<pred> <action>) ...(else <action>)) 

(define (cond? exp) (tagged-list? exp ’cond)) 

(define (cond-clauses exp) (cdr exp)) 

(define (cond-else-clause? clause)

   (eq? (cond-predicate clause) ’else)) 

(define (cond-predicate clause) (car clause))

(define (cond-actions clause) (cdr clause))

(define (cond->if exp)

    (expand-clauses (cond-clauses exp)))

 
 
 
 
 

29  

Expanding cond into if 

(define (expand-clauses clauses)

  (if (null? clauses)

      ’false                    ; no else clause

      (let ((first (car clauses))

           ((rest (cdr clauses)))

        (if (cond-else-clause? first)

            (if (null? rest)

                (sequence->exp (cond-action first))

                (error “ELSE clause isn’t last -”

                       clauses))

            (make-if (cond-predicate first)

                     (sequence->exp

                           (cond-actions first))

                     (expand->clauses rest))))))

 
 
 
 
 

30  

Evaluator Data Structures 

  • Evaluator implementation must define data structures that the evaluator manipulates internally, such as symbol table, the representation of environments and the representation of true and false.
 
  • False and True objects
 

  (define (true? x) (not (eq? x false)))

  (define (false? x)(eq? x false))

 
 
 
 
 

31  

Representing Procedures 

  • Procedure-related utilities
    • (apply-primitive-procedure <proc> <args>)
      • applies the given primitive proc to the arguements
    • (primitive-procedure? <proc>)
      • test whether <proc> is a primitive procedure
 
  • Compound procdures are constructed from parameters, procedure bodies, and environments.
 
 
 
 
 

32  

Representing Procedures -code 

;; Representing procedures

(define (make-procedure parameters body env)

  (list 'procedure parameters body env)) 

(define (compound-procedure? exp)

  (tagged-list? exp 'procedure)) 

(define (procedure-parameters p) (list-ref p 1)) 

(define (procedure-body p) (list-ref p 2)) 

(define (procedure-environment p) (list-ref p 3))

;(define (procedure-environment p) (cadddr p))

 
 
 
 
 

33  

Operations on Environments 

  • Environments- a sequence of frames
    • (lookup-variable-value <var> <env>)
      • returns the value that is bound to the symbol <var> in environment <env>, or signal error if not defined.
    • (extend-environment <variables> <values> <base-env>)
      • add (<var> <val>) pairs to <base-env>
    • (define-variable! <var> <value> <env>)
      • add to the first frame in the environment <env> a new binding (<var> <value>)
    • (set-variable-value! <var> <value> <env>)
      • change the binding of the variable <var> in the environemnt <env> or signal error if not defined.
 
 
 
 
 

34  

Representing Environment 

;; Representing environments

;;

;; Implement environments as a list of frames; parent

;; environment is the cdr of the list.  Each frame will

;; be implemented as a list of variables and a list of

;; corresponding values.

(define (enclosing-environment env) (cdr env))

(define (first-frame env) (car env))

(define the-empty-environment '()) 

(define (make-frame variables values)

   (cons variables values))

(define (frame-variables frame) (car frame))

(define (frame-values frame) (cdr frame))

(define (add-binding-to-frame! var val frame)

  (set-car! frame (cons var (car frame)))

  (set-cdr! frame (cons val (cdr frame))))

 
 
 
 
 

35  

Adding a new frame 

; Extending an environment by a new frame is just

; adding a new frame (pair of list of var and list of

; values) to the base environment 

(define (extend-environment vars vals base-env)

  (if (= (length vars) (length vals))

      (cons (make-frame vars vals) base-env)

      (if (< (length vars) (length vals))

          (error "Too many args supplied" vars vals)

          (error "Too few args supplied" vars vals))))

 
 
 
 
 

36  

Look up a variable in an environment 

(define (lookup-variable-value var env)

  (define (env-loop env)

    (define (scan vars vals)

      (cond ((null? vars)

             (env-loop (enclosing-environment env)))

            ((eq? var (car vars))

             (car vals))

            (else (scan (cdr vars) (cdr vals)))))

    (if (eq? env the-empty-environment)

        (error "Unbound variable -- LOOKUP" var)

        (let ((frame (first-frame env)))

          (scan (frame-variables frame)

                (frame-values frame)))))

  (env-loop env))

 
 
 
 
 

37  

Set a variable to a new value 

(define (set-variable-value! var val env)

  (define (env-loop env)

    (define (scan vars vals)

      (cond ((null? vars)

             (env-loop (enclosing-environment env)))

            ((eq? var (car vars))

             (set-car! vals val))

                    ; Same as lookup except for this

            (else (scan (cdr vars) (cdr vals)))))

    (if (eq? env the-empty-environment)

        (error "Unbound variable -- SET!" var)

        (let ((frame (first-frame env)))

          (scan (frame-variables frame)

                (frame-values frame)))))

  (env-loop env))

 
 
 
 
 

38  

Define a variable 

; search the first frame for a binding for the

; varible, and change the binding if it exists.

; If not defined, add a binding to the first frame. 

(define (define-variable! var val env)

  (let ((frame (first-frame env)))

    (define (scan vars vals)

      (cond ((null? vars)

             (add-binding-to-frame! var val frame))

            ((eq? var (car vars))

             (set-car! vals val))

            (else (scan (cdr vars) (cdr vals)))))

    (scan (frame-variables frame)

          (frame-values frame))))

 
 
 
 
 

39  

Running the Evaluator as a Program 

  • Given evaluator is a description (expressed in Scheme) of the process for evaluation Lisp expressions.
    • Operational Semantics : run it as a program
  • Given evaluator will reduce the evaluated expression into applications of primitive procedures, which in turn will be implemented in calling the procedures of the implementing language
  • Global environment: primitives and true, false
 
 
 
 
 

40  

Environment Setup 

(define (setup-environment)

  (let ((initial-env

        (extend-environment (primitive-procedure-names)

                            (primitive-procedure-objects)

                             the-empty-environment)))

    (define-variable! 'true #t initial-env)

    (define-variable! 'false #f initial-env)

    initial-env)) 

(define the-global-environment (setup-environment))

 
 
 
 
 

41  

Primitive Procesures 

;; Primitive Procedures and the Initial Environment

; Representation of primitive procedure objects

; does not matter, so long as the apply can identify

; and apply them by using abstract procedures. 

(define (primitive-procedure? proc)

   (tagged-list? proc 'primitive))

(define (primitive-implementation proc) (cadr proc)) 

(define primitive-procedures

  (list (list 'car car)

        (list 'cdr cdr)

        (list 'cons cons)

        (list 'null? null?)

        ; ... more primitives

        ))

 
 
 
 
 

42  

Making environment from list 

(define (primitive-procedure-names)

   (map car primitive-procedures))

(define (primitive-procedure-objects)

  (map (lambda (proc) (list 'primitive (cadr proc)))

       primitive-procedures)) 

; need to distinguish apply in implemented and

; implementing languages

; (define apply-in-underlying-scheme apply)

(define (apply-primitive-procedure proc args)

  (apply-in-underlying-scheme

   (primitive-implementation proc) args))

 
 
 
 
 

43  

Read-Eval-Print Loop : Interpreter 

;; The Read-Eval-Print Loop

(define input-prompt ";;; M-Eval input:")

(define output-prompt ";;; M-Eval value:")

(define (driver-loop)

  (prompt-for-input input-prompt)

  (let ((input (read)))

    (let ((output (eval input the-global-environment)))

      (announce-output output-prompt)

      (display output)))       

  (driver-loop)) 

(define (prompt-for-input string)

  (newline) (newline) (display string) (newline))

(define (announce-output string)

  (newline) (display string) (newline))


신고
Trackback 14 Comment 0


티스토리 툴바