EOPL 第3章の Exercise 3.31 から 3.33

3.31 は動的スコープを実装するもう一つの方法として、グローバルなスタックにバインディングを置いてプロシージャの始まる時に push、戻る時に pop するというもの。

3.32 は動的スコープだと再帰は特別なことしなくてもできるよという話で、3.33 はレキシカルスコープと違って動的スコープだと変数の名前をうっかり変えただけで思いもよらぬところに影響が出て分かりにくいよという話。

さてこれで 3.5 節の練習問題がやっと片付いた。3.19 からちまちまと1ヶ月くらいやってたけどこれでたったの4ページ分しか進んでいない。

; Exercise 3.31 from p.91
(load "r5rs.scm")
(load "define-datatype.scm")
(load "sllgen.scm")
(use srfi-1)

(define true-value (lambda () 1))
(define false-value (lambda () 0))
(define true-value?
  (lambda (x)
    (not (= 0 x))))

(define env '(() ())) ; the global stack

(define apply-env
  (lambda (id)
    (let ((idx (list-index (lambda (x) (eqv? x id)) (car env))))
      (if idx
        (list-ref (cadr env) idx)
        (eopl:error 'apply-env "")))))

(define push-env
  (lambda (ids vals)
    (set!  env
      (list
        (append ids (car env))
        (append vals (cadr env))))))

(define pop-env
  (lambda (n)
    (set! env
      (list
        (drop (car env) n)
        (drop (cadr env) n)))))

(define eval-program
  (lambda (pgm)
    (cases program pgm
      (a-program (body)
        (eval-expression body)))))

(define eval-expression
  (lambda (exp)
    (cases expression exp
      (lit-exp (datum) datum)
      (var-exp (id) (apply-env id))
      (primapp-exp (prim rands)
        (let ((args (eval-rands rands)))
          (apply-primitive prim args)))
      (if-exp (test-exp true-exp false-exp)
        (if (true-value? (eval-expression test-exp))
          (eval-expression true-exp)
          (eval-expression false-exp)))
      (let-exp (ids rands body)
        (let ((args (eval-rands rands)))
          (push-env ids args)
          (let ((result (eval-expression body)))
            (pop-env (length ids))
            result)))
      (proc-exp (ids body)
        (lambda (args)
          (if (= (length ids) (length args))
            (begin
              (push-env ids args)
              (let ((result (eval-expression body)))
                (pop-env (length ids))
                result))
            (eopl:error 'proc-exp ""))))
      (app-exp (rator rands)
        (let ((proc (eval-expression rator))
              (args (eval-rands rands)))
          (proc args)))
      )))

(define eval-rands
  (lambda (rands)
    (map (lambda (x) (eval-rand x)) rands)))

(define eval-rand
  (lambda (rand)
    (eval-expression rand)))

(define apply-primitive
  (lambda (prim args)
    (cases primitive prim
      (add-prim () (+ (car args) (cadr args)))
      (subtract-prim () (- (car args) (cadr args)))
      (mult-prim () (* (car args) (cadr args)))
      (incr-prim () (+ (car args) 1))
      (decr-prim () (- (car args) 1))
      (zero?-prim () (if (= 0 (car args)) (true-value) (false-value)))
      )))

(define scanner-spec-3.31
  '((white-sp
      (whitespace) skip)
    (comment
      ("%" (arbno (not #\newline))) skip)
    (identifier
      (letter (arbno (or letter digit "?"))) symbol)
    (number
      (digit (arbno digit)) number)))

(define grammar-3.31
  '((program
      (expression)
      a-program)
    (expression
      (number)
      lit-exp)
    (expression
      (identifier)
      var-exp)
    (expression
      (primitive "(" (separated-list expression ",") ")" )
      primapp-exp)
    (expression
      ("if" expression "then" expression "else" expression)
      if-exp)
    (expression
      ("let" (arbno identifier "=" expression) "in" expression)
      let-exp)
    (expression
      ("proc" "(" (separated-list identifier ",") ")" expression)
      proc-exp)
    (expression
      ("(" expression (arbno expression) ")")
      app-exp)
    (primitive ("+") add-prim)
    (primitive ("-") subtract-prim)
    (primitive ("*") mult-prim)
    (primitive ("add1") incr-prim)
    (primitive ("sub1") decr-prim)
    (primitive ("zero?") zero?-prim)
    ))

(define scan&parse
  (sllgen:make-string-parser
    scanner-spec-3.31
    grammar-3.31))

(sllgen:make-define-datatypes scanner-spec-3.31 grammar-3.31)

(define run
  (lambda (string)
    (eval-program
      (scan&parse string))))

(define read-eval-print
  (sllgen:make-rep-loop "-->" eval-program
    (sllgen:make-stream-parser
      scanner-spec-3.31
      grammar-3.31)))

; Exercise 3.32 from p.92
; let odd = proc (x) if x then (even sub1(x)) else 0 in
; let even = proc (x) if x then (odd sub1(x)) else 1 in
; (even 123)

; Exercise 3.33 from p.92
; let a = 3
;     p = proc () a
; in let f = proc (x) (p)
;        a = 5
;    in (f 2)
; -->5
;
; let a = 3
;     p = proc () a
; in let f = proc (a) (p)
;        a = 5
;    in (f 2)
; -->2