EoPL reading (144) 3.2 The Front End
試験を書きかけて判明。emptylist を定義してない。
(use gauche.test) (add-load-path ".") (load "parse-program") (load "Fig3.2") (load "run") (test-start "Ex.3.7") (test-section "example") (test* "(run '(list 1 2 3))" '(1 2 3) (run '(list 1 2 3))) (test* "(run '(car (cons 4 emptylist)))" 4 (run '(car (cons 4 emptylist)))) (test-end)
しかも試験に通らない。
$ make Testing parse-program ... passed. Testing Ex.3.6 ... passed. Testing Ex.3.7 ... failed. discrepancies found. Errors are: test (run '(list 1 2 3)): expects (1 2 3) => got ((1 2 3)) test (run '(car (cons 4 emptylist))): expects 4 => got #<error "apply-env \"No binding for ~s\" emptylist"> Testing Fig3.2 ... passed. Testing parse-program ... passed. Testing run ... passed. $
うーん。微妙、って言いつつソース確認。
まず、list が微妙。
;; (list-prim () (list args)) (list-prim () args)
上記で正常動作。あと、emptylist が解決できない件は init-env に盛り込み。
(define init-env (lambda () (extend-env ;; '(i v x) ;; '(1 5 10) '(i v x emptylist) '(1 5 10 '()) (empty-env))))
もう少し試験追加の必要あり。現実トウヒ終了。
帰宅後
散歩しつつ emptylist 変数じゃなくて手続きにもできるな、という事に気づく。これは一旦置いといて試験を追加。
(use gauche.test) (add-load-path ".") (load "parse-program") (load "Fig3.2") (load "run") (test-start "Ex.3.7") (test-section "example") (test* "(run '(list 1 2 3))" '(1 2 3) (run '(list 1 2 3))) (test* "(run '(car (cons 4 emptylist)))" 4 (run '(car (cons 4 emptylist)))) (test-section "list, cons, car, cdr") (test* "(run '(cdr (list 1 2 3)))" '(2 3) (run '(cdr (list 1 2 3)))) (test* "(run '(car (list 1 2 3)))" '1 (run '(car (list 1 2 3)))) (test* "(run '(car (cons 1 2)))" '1 (run '(car (cons 1 2)))) (test* "(run '(cdr (cons 1 2)))" '2 (run '(cdr (cons 1 2)))) (test* "(run '(cons 1 (cons 2 emptylist)))" '(1 2) (run '(cons 1 (cons 2 emptylist)))) (test-end)
最後のがパスしない。
Testing Ex.3.7 ... failed. discrepancies found. Errors are: test (run '(cons 1 (cons 2 emptylist))): expects (1 2) => got (1 2 quote ())
これはやはり primitive な手続きにした方が良い模様。と言いつつ quote してるのが悪いのか。こうすれば試験パス。
(define init-env (lambda () (extend-env '(i v x emptylist) '(1 5 10 ()) (empty-env))))
emptylist は variable ってなってるのでこの実装で良い模様。以下に実装を列挙しときます。試験は略で。
- Fig2.3.scm
(define eopl:error error) (define empty-env (lambda () (lambda (sym) (eopl:error 'apply-env "No binding for ~s" sym)))) (define extend-env (lambda (syms vals env) (lambda (sym) (let ((pos (list-find-position sym syms))) (if (number? pos) (list-ref vals pos) (apply-env env sym)))))) (define apply-env (lambda (env sym) (env sym))) (define has-association? (lambda (env sym) (guard (e (else #f)) (env sym) #t))) (define list-find-position (lambda (sym los) (list-index (lambda (sym1) (eqv? sym1 sym)) los))) (define list-index (lambda (pred ls) (cond ((null? ls) #f) ((pred (car ls)) 0) (else (let ((list-index-r (list-index pred (cdr ls)))) (if (number? list-index-r) (+ list-index-r 1) #f))))))
- Fig3.2.scm
(add-load-path ".") (load "define-datatype") (load "simple-interpreter") (load "Fig2.3") (define eval-program (lambda (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 () (print (car args)) 1) (minus-prim () (- (car args))) (list-prim () args) (cons-prim () (cons (car args) (cadr args))) (car-prim () (car (car args))) (cdr-prim () (cdr (car args))) ))) (define init-env (lambda () (extend-env '(i v x emptylist) '(1 5 10 ()) (empty-env))))
- parse-program.scm
(define parse-program (lambda (datum) (list 'a-program (parse-expression datum)))) (define parse-expression (lambda (datum) (cond ((number? datum) (list 'lit-exp datum)) ((symbol? datum) (list 'var-exp datum)) ((pair? datum) (list 'primapp-exp (list (cond ((eq? '+ (car datum)) 'add-prim) ((eq? '- (car datum)) 'subtract-prim) ((eq? '* (car datum)) 'mult-prim) ((eq? 'add1 (car datum)) 'incr-prim) ((eq? 'sub1 (car datum)) 'decr-prim) ((eq? 'print (car datum)) 'print-prim) ((eq? 'minus (car datum)) 'minus-prim) ((eq? 'list (car datum)) 'list-prim) ((eq? 'cons (car datum)) 'cons-prim) ((eq? 'car (car datum)) 'car-prim) ((eq? 'cdr (car datum)) 'cdr-prim) )) (map (lambda (x) (parse-expression x)) (cdr datum)))))))
- run.scm
(add-load-path ".") (load "parse-program") (load "Fig3.2") (define run (lambda (x) (eval-program (parse-program x))))
- simple-interpreter.scm
(add-load-path ".") (load "define-datatype") (define list-of (lambda (pred) (lambda (val) (or (null? val) (and (pair? val) (pred (car val)) ((list-of pred) (cdr val))))))) (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) (list-prim) (cons-prim) (car-prim) (cdr-prim) )
なんか色々ありますね。。