So-net無料ブログ作成
検索選択

EOPL 第3章の Exercise 3.1 から 3.9 答案 [Lisp]

第3章ではインタプリタの製作を開始する。SLLGEN という Scheme 用のパーサジェネレータによるフロントエンドの作り方も導入される。この本は構文解析については SLLGEN の使い方を教えるだけで、「もし使っている言語にパーサジェネレータが無ければパーサを手書きする方法もある。やり方は大抵のコンパイラのテキストに書いてあるから」で済ませている。

練習問題 3.1 と 3.3 は前章でもやっていたような構文木のリスト化とその逆。3.5 から 3.8 は簡単なインタプリタに新しいプリミティブを追加する問題。3.9 は引数の数のチェック機能を付け加える問題。まだそんなに面白くなるところではない感じ。

練習問題 3.7 と 3.8 で問われている expressed value と denoted value という用語の使い方が良く分からなかった。 expressed value は "the possible values of expresions" で、denoted value は "the values bound to variables" だと言っていて、最初の版のインタプリタでは Expressed Value = Denoted Value = Number である。練習問題 3.7 で cons などなどを追加するとたぶん Expressed Value = Denoted Value = Number + List of Values(?) になる。練習問題 3.8 で setcar (リストの car の破壊的変更)を追加すると…まだ変わらない、でいいのかな?

; Exercise 3.1 from p.72
(define program-to-list
  (lambda (exp)
    (cases program exp
      (a-program (exp) (list 'a-program (expression-to-list exp))))))

(define expression-to-list
  (lambda (exp)
    (cases expression exp
      (lit-exp (datum) (list 'lit-exp datum))
      (var-exp (id) (list 'var-exp id))
      (primapp-exp (prim rands)
        (list 'primapp-exp
              (primitive-to-list prim)
              (map expression-to-list rands))))))

(define primitive-to-list
  (lambda (prim)
    (cases primitive prim
      (add-prim () '(add-prim))
      (subtract-prim () '(subtract-prim))
      (mult-prim () '(mult-prim))
      (incr-prim () '(incr-prim))
      (decr-prim () '(decr-prim)))))

; Exercise 3.3 from p.79
(define parse-program
  (lambda (datum)
    (a-program (parse-expression datum))))

(define parse-expression
  (lambda (datum)
    (cond
      ((number? datum) (lit-exp datum))
      ((symbol? datum) (var-exp datum))
      ((list? datum)
       (primapp-exp
         (parse-primitive (car datum))
         (map parse-expression (cdr datum)))))))

(define parse-primitive
  (lambda (datum)
    (cond
      ((eqv? '+ datum) (add-prim))
      ((eqv? '- datum) (subtract-prim))
      ((eqv? '* datum) (mult-prim))
      ((eqv? 'add1 datum) (incr-prim))
      ((eqv? 'sub1 datum) (decr-prim)))))

以下は Exercise 3.5 から 3.9 までの機能を追加した結果

(load "r5rs.scm")
(load "define-datatype.scm")
(load "sllgen.scm")
(load "2-3-2.scm") ; for extend-env etc.
(use srfi-1) ; for every

(define-datatype program program?
  (a-program
    (exp expression?)))

(define-datatype expression expression?
  (lit-exp
    (datum number?))
  (var-exp
    (id symbol?))
  (primapp-exp
    (prim primitive?)
    (rands (list-of expression?))))

(define-datatype primitive primitive?
  (add-prim)
  (subtract-prim)
  (mult-prim)
  (incr-prim)
  (decr-prim)
  (print-prim)
  (minus-prim)
  (cons-prim)
  (car-prim)
  (cdr-prim)
  (list-prim)
  (setcar-prim))

(define eval-program
  (lambda (pgm)
    (and
      (validate-program pgm)
      (cases program pgm
        (a-program (body)
          (eval-expression body (init-env)))))))

(define eval-expression
  (lambda (exp env)
    (cases expression exp
      (lit-exp (datum) datum)
      (var-exp (id) (apply-env env id))
      (primapp-exp (prim rands)
        (let ((args (eval-rands rands env)))
          (apply-primitive prim args))))))

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

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

(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))
      (print-prim () (begin (print (car args)) 1))
      (minus-prim ()  (- (car args)))
      (cons-prim () (cons (car args) (cadr args)))
      (car-prim () (car (car args)))
      (cdr-prim () (cdr (car args)))
      (list-prim () args)
      (setcar-prim () (begin (set! (car (car args)) (cadr args)) (car args))))))

(define init-env
  (lambda ()
    (extend-env
      '(emptylist i v x)
      '(()        1 5 10)
      (empty-env))))

(define validate-program
  (lambda (pgm)
    (cases program pgm
      (a-program (exp)
        (validate-expression exp)))))

(define validate-expression
  (lambda (exp)
    (cases expression exp
      (lit-exp (datum) #t)
      (var-exp (id) #t)
      (primapp-exp (prim rands)
        (and
          (cases primitive prim
            (add-prim () (= 2 (length rands)))
            (subtract-prim () (= 2 (length rands)))
            (mult-prim () (= 2 (length rands)))
            (incr-prim () (= 1 (length rands)))
            (decr-prim () (= 1 (length rands)))
            (print-prim () (= 1 (length rands)))
            (minus-prim () (= 1 (length rands)))
            (cons-prim () (= 2 (length rands)))
            (car-prim () (= 1 (length rands)))
            (cdr-prim () (= 1 (length rands)))
            (list-prim () #t)
            (setcar-prim () (= 2 (length rands))))
          (every validate-expression rands))))))

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

(define grammar-3-1
  '((program
      (expression)
      a-program)
    (expression
      (number)
      lit-exp)
    (expression
      (identifier)
      var-exp)
    (expression
      (primitive "(" (separated-list expression ",") ")" )
      primapp-exp)
    (primitive ("+") add-prim)
    (primitive ("-") subtract-prim)
    (primitive ("*") mult-prim)
    (primitive ("add1") incr-prim)
    (primitive ("sub1") decr-prim)
    (primitive ("print") print-prim)
    (primitive ("minus") minus-prim)
    (primitive ("cons") cons-prim)
    (primitive ("car") car-prim)
    (primitive ("cdr") cdr-prim)
    (primitive ("list") list-prim)
    (primitive ("setcar") setcar-prim)))

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

(sllgen:make-define-datatypes scanner-spec-3-1 grammar-3-1)

(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-1
      grammar-3-1)))

nice!(0)  コメント(0)  トラックバック(0) 
共通テーマ:パソコン・インターネット

nice! 0

コメント 0

コメントを書く

お名前:
URL:
コメント:
画像認証:
下の画像に表示されている文字を入力してください。

トラックバック 0

この記事のトラックバックURL:
※言及リンクのないトラックバックは受信されません。

この広告は前回の更新から一定期間経過したブログに表示されています。更新すると自動で解除されます。