Scheme演習 第5回

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

関数から返された関数

> (define (make-adder n)
    (lambda (m) (+ m n)))
> (define add1 (make-adder 1))
> (define add2 (make-adder 2))
> (add1 10)  ; add1 は (lambda (m) (+ m n)) という式と、n=1 だったことを覚えている
11
> (add2 10)  ; add2 は (lambda (m) (+ m n)) という式と、n=2 だったことを覚えている
12

解説

環境モデルの続き

let

(let ((v1 e1) (v2 e2) ... (vn en)) <body> ...)
((lambda (v1 v2 ... vn) <body> ...)
 e1 e2 ... en)
と同じことである。

ここで、ei は拡張された環境で評価されるのではないことに注意。
> ((lambda (a b c) (+ a b c))
   3 7 2)
12
> (let ((a 3) (b 7) (c 2)) (+ a b c))
12
> (let ((a 3) (b a) (c 2)) (+ a b c))
*** ERROR IN (stdin)@10.16 -&minus; Unbound variable: a
1>

局所変数(局所関数)

1 > (define (fac n)
      (define (iter-fac product counter)
        (if (> counter n)     ;  iter-fac が作られたときのフレームの n を参照
            product
            (iter-fac (* product counter) (+ counter 1))))
      (iter-fac 1 1))
2 > (fac 1)           ; (fac 1) の実行中に iter-fac が定義されている
  1

環境モデルの実装による再現

  > (define init-env (make-env))
1 > (define-value! 'fac
      (list '*lambda* '(n)
        '(begin (define (iter-fac product counter)
                  (if (> counter n)
                      product
                      (iter-fac (* product counter) (+ counter 1))))
                (iter-fac 1 1))
        init-env)
      init-env)
2 > (define fac-env (extend init-env '(n) '(1)))
2 > (define-value! 'iter-fac
      (list '*lambda* '(product counter)
        '(if (> counter n)
             product
             (iter-fac (* product counter) (+ counter 1)))
        fac-env)
      fac-env)
2 > (define iter-fac-env (extend fac-env '(product counter) '(1 1)))
2 > (get 'counter iter-fac-env)  ; (> counter n) の計算のため
  (counter . 1)
2 > (get 'n iter-fac-env)        ; (> counter n) の計算のため
  (n . 1)
2 > (get 'product iter-fac-env)  ; (* product counter) の計算のため
  (product . 1)
2 > (get 'counter iter-fac-env)  ; (* product counter) の計算のため
  (counter . 1)
2 > (get 'counter iter-fac-env)  ; (+ counter 1) の計算のため
  (counter . 1)
2 > (define iter-fac2-env (extend fac-env '(product counter) '(1 2)))
2 > (get 'counter iter-fac2-env) ; (> counter n) の計算のため
  (counter . 2)
2 > (get 'n iter-fac2-env)       ; (> counter n) の計算のため
  (n . 1)
2 > (get 'product iter-fac2-env)
  (product . 1)

高階関数 (higher-order functions)

1 > (define (make-adder n)
      (lambda (m) (+ m n)))
2 > (define add1 (make-adder 1))
3 > (define add2 (make-adder 2))
4 > (add1 3)
  4

環境モデルの実装による再現

  > (define init-env (make-env))
1 > (define-value! 'make-adder
      (list '*lambda* '(n)
        '(lambda (m) (+ m n))
        init-env)
      init-env)
2 > (define make-adder-env (extend init-env '(n) '(1)))
2 > (define-value! 'add1
      (list '*lambda* '(m)
        '(+ m n)
        make-adder-env)
      init-env)
3 > (define make-adder2-env (extend init-env '(n) '(2)))
3 > (define-value! 'add2
      (list '*lambda* '(m)
        '(+ m n)
        make-adder2-env)
      init-env)
4 > (define add1-env (extend make-adder-env '(m) '(3)))
4 > (get 'm add1-env)
  (m . 3)
4 > (get 'n add1-env)
  (n . 1)

シンタックス形式set!

> (define x (cons 'a 'b))
> (define y x)
> (set-car! y 'aaa)
> (set! y 'ccc)
> y
ccc
> x
(aaa . b)

状態を持つ関数の例:銀行口座

局所変数 (Local Variable) の書き換え

(define (make-withdraw balance)
  (lambda (amount)
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds")))
1 > (define w1 (make-withdraw 10000))
2 > (define w2 (make-withdraw 5000))
3 > (w1 1000)
  9000
4 > (w2 6000)
  "Insufficient funds"
5 > (w1 6000)
  3000

オブジェクト指向風

(define (make-account balance)
  (define (withdraw amount)       ;  引き出し
    (if (>= balance amount)
        (begin (set! balance (- balance amount))
               balance)
        "Insufficient funds"))
  (define (deposit amount)        ;  預金
    (set! balance (+ balance amount))
    balance)
  (define (dispatch m amount)
    (cond ((eq? m 'withdraw) (withdraw amount))
          ((eq? m 'deposit) (deposit amount))
          (else "Unknown request")))
  dispatch)
(define acc (make-account 10000))
> (acc 'withdraw 5000)
5000
> (acc 'withdraw 6000)
"Insufficient funds"
> (acc 'deposit 4000)
9000
> (acc 'withdraw 6000)
3000

レポート課題5

問1

> (nisizawa-acc 'hagya 'deposit 10000)
"incorrect password"
> (define acc (make-account 10000 'password))
> (acc 'password 'withdraw 3000)
7000
> (acc 'password 'withdraw 10000)
"Insufficient funds"
> (acc 'password 'deposit 1000)
8000
> (acc 'wrong 'withdraw 5000)
"incorrect password"
> (acc 'password 'withdraw 5000)
3000
> (acc 'wrong 'withdraw 1000)
"incorrect password"
> (acc 'pass 'deposit 1000)
"incorrect password"
> (acc 'word 'withdraw 1000)
"You're under arrest."

問2

  > (define init-env (make-env))
  > (define-value! 'make-withdraw
      (list '*lambda* '(balance)
        '(lambda (amount)
           (if (>= balance amount)
               (begin (set! balance (- balance amount))
                      balance)
               "Insufficient funds"))
        init-env)
      init-env)
1 > (define make-withdraw-env (extend init-env '(balance) '(10000)))
1 > (define-value! 'w1
      (list '*lambda* '(amount)
        '(if (>= balance amount)
             (begin (set! balance (- balance amount))
                    balance)
             "Insufficient funds")
        make-withdraw-env)
      init-env)
2 > (define make-withdraw2-env (extend init-env '(balance) '(5000)))
2 > (define-value! 'w2
      (list '*lambda* '(amount)
        '(if (>= balance amount)
             (begin (set! balance (- balance amount))
                    balance)
             "Insufficient funds")
        make-withdraw2-env)
      init-env)
3 > (define w1-env (extend make-withdraw-env '(amount) '(1000)))
3 > (get 'balance w1-env)
  (balance . 10000)
3 > (get 'amount w1-env)
  (amount . 1000)
3 > (get 'balance w1-env)
  (balance . 10000)
3 > (get 'amount w1-env)
  (amount . 1000)
3 > (set!-value! 'balance 9000 w1-env)
3 > (get 'balance w1-env)
  (balance . 9000)
4 > (define w2-env (extend make-withdraw2-env '(amount) '(6000)))
4 > (get 'balance w2-env)
  (balance . 5000)
4 > (get 'amount w2-env)
  (amount . 6000)
5 > (define w12-env (extend make-withdraw-env '(amount) '(6000)))
5 > (get 'balance w12-env)
  (balance . 9000)
5 > (get 'amount w12-env)
  (amount . 6000)
5 > (get 'balance w12-env)
  (balance . 9000)
5 > (get 'amount w12-env)
  (amount . 6000)
5 > (set!-value! 'balance 3000 w12-env)
5 > (get 'balance w12-env)
  (balance . 3000)