[Index] [TOC]

Scheme演習 第6回


品川 嘉久, 浅井 健一, 萩谷 昌己, 西澤 弘毅, 原 謙治

インタプリタとは

(define (tashizan-interpreter)
  (define (base-eval exp)
    (cond ((number? exp) exp)
          ((and (pair? exp) (eq? (car exp) 'tashizan))
             (+ (base-eval (cadr exp)) (base-eval (caddr exp))))
          (else "syntax error")))
  (display " ")
  (let ((answer (base-eval (read))))  ; ここで入力待ち
    (display "= ")
    (write answer))
  (newline)
  (tashizan-interpreter))
> (tashizan-interpreter)
 (tashizan 1 (tashizan 2 3))
= 6
 (+ 1 2)
= "syntax error"

トップレベルループ

(define (REP-loop)
  (display "input  > ")
  (let ((answer (base-eval (read) init-env)))
    (display "output : ")
    (write answer))
  (newline)
  (REP-loop))
> (REP-loop)
input  > (+ 1 2)
output : 3
input  >

dispatcher

(define (base-eval exp env)
  (cond ((number? exp)           exp)
        ((boolean? exp)          exp)
        ((string? exp)           exp)
        ((symbol? exp)           (eval-var exp env))    ; 3 節
        ((eq? (car exp) 'define) (eval-define exp env)) ; 3 節
        ((eq? (car exp) 'lambda) (eval-lambda exp env)) ; 3 節
        ((eq? (car exp) 'set!)   (eval-set! exp env))   ; 3 節
        ((eq? (car exp) 'quote)  (eval-quote exp env))  ; 3 節
        ((eq? (car exp) 'if)     (eval-if exp env))     ; 3 節
        ((eq? (car exp) 'load)   (eval-load exp env))   ; 5 節
        (else (eval-application exp env))))             ; 4 節

シンタックス形式

(define init-env (list (list
  (cons 'car      (list *primitive* 'car))
  (cons 'cdr      (list *primitive* 'cdr))
  ...
)))

*primitive*と*lambda*

(define *lambda* (list 'lambda))
(define *primitive* (list 'primitive))

変数

(define (eval-var exp env) ; exp = var
  (let ((pair (get exp env)))
    (if (pair? pair)
        (cdr pair)
        (error (list 'eval-var: 'unbound 'variable: exp)))))

define

(define (eval-define exp env) ; exp = (define var body)
  (let* ((var (cadr exp))
         (body (caddr exp))
         (value (base-eval body env)))
    (define-value! var value env) ; env の最外フレームに(var . value)を加える。
    var))

lambda

(define (eval-lambda exp env) ; exp = (lambda params body)
  (let ((params (cadr exp))
        (body   (caddr exp)))
    (list *lambda* params body env)))
input  > (lambda (x) (+ x 1))
output : ((lambda) (x) (+ x 1) (((car (primitive) car)...

set!

(define (eval-set! exp env) ; exp = (set! var body)
  (let* ((var (cadr exp))
         (body (caddr exp))
         (value (base-eval body env)))
    (set!-value! var value env))) ; env の var を value に書き換える。

quote

(define (eval-quote exp env) ; exp = 'body = (quote body)
  (cadr exp))
input  > '(+ 1 2)
output : (+ 1 2)
input  > (+ 1 2)
output : 3

if

(define (eval-if exp env) ; exp = (if pred-part then-part else-part)
  (let ((pred-part (cadr exp))
        (then-part (caddr exp))
        (else-part (cadddr exp)))
    (if (base-eval pred-part env)
        (base-eval then-part env)
        (base-eval else-part env))))

関数適用

(define (eval-application exp env) ; exp = (f a b c ...)
  (let ((lst (map (lambda (e) (base-eval e env)) exp)))
    (base-apply (car lst) (cdr lst))))

関数の種類

primitive関数

input  > (car '(1 2))
...
| > (base-apply '((primitive) car) '((1 2)))
...
output : 1

ユーザ定義関数

input  > ((lambda (x) (+ x 1)) 2)
...
| > (base-apply '((lambda) (x) (+ x 1) (((car (primitive) car) (cdr (primiti...
...
| > (base-eval '(+ x 1) '(((x . 2)) ((car (primitive) car) (cdr (primitive) ...
...
| > (base-apply '((primitive) +) '(2 1))
...
output : 3

base-apply

(define (base-apply operator operand)
  (cond ((and (pair? operator) ; <============== primitive はここ
              (eq? (car operator) *primitive*))
         (let ((name (cadr operator)))
           (cond ((eq? name 'car)        (car (car operand)))
                 ((eq? name 'cdr)        (cdr (car operand)))
                 ((eq? name 'cadr)       (cadr (car operand)))
                 ((eq? name 'caddr)      (caddr (car operand)))
                 ((eq? name 'cadddr)     (cadddr (car operand)))
                 ((eq? name 'cons)       (cons (car operand)
                                               (cadr operand)))
                 ((eq? name 'list)       operand)
                 ...
                 (else
                  (error (list 'base-apply: 'unknown 'primitive: name))))))
        ((and (pair? operator) ; <============== lambda はここ
              (eq? (car operator) *lambda*))
         (let ((lambda-params (cadr operator))
               (lambda-body   (caddr operator))
               (lambda-env    (cadddr operator)))
           (base-eval lambda-body
                      (extend lambda-env lambda-params operand)))); 環境を拡張
        (else
         (error (list 'base-apply: 'not 'a 'function: operator)))))

Load

(define (eval-load exp env) ; exp = (load filename)
  (define port (open-input-file (cadr exp)))
  (define (load-local)
    (let ((input (read port)))
      (if (eof-object? input)
          (begin (close-input-port port) 'done)
          (begin (base-eval input env)
                 (load-local)))))
  (load-local))

レポート課題6

問1

問2

問3

(define f (lambda (x) (cons x x)))
(define (f x) (cons x x))

問4

(let ((a1 e1) (a2 e2) ... (an en)) body)
は、
((lambda (a1 a2 ... an) body) e1 e2 ... en)
と等価である

問5

問6(成績に考慮しない)

input  > (define (f x) (* x x))
output : f
input  > (f y)
(eval-var: unbound variable: y)
input return value > 3
output : 9
input  > (+ 1 (2 3))
(base-apply: not a function: 2)
input return value > 5
output : 6

問7(成績に考慮しない)


This page is generated by mtd2html.