EOPL 第3章の Exercise 3.10 から 3.15 [Lisp]
3.3 節ではインタプリタに条件式を追加した。
最初は真偽値を使わずにゼロ/非ゼロで代用するんだけど、練習問題の 3.14 では扱う値に Bool を追加してさらに if の条件節に Bool が来なかった場合はエラーとするように改造する。
その一方で 3.15 では <bool-exp> という新しい nonterminal を追加する。
練習問題 3.15 は何をやったことになるんだろうか。これだと if の条件節に <bool-exp> がこなかった場合は実行時でなくパース時のエラーになるというところがよい？出来上がったものを見るとなんかもやっとしたものを感じるけど。
; Exercise 3.11 .. 3.14
(load "r5rs.scm")
(load "define-datatype.scm")
(load "sllgen.scm")
(load "2-3-2.scm") ; for extend-env etc.
(define true-value (lambda () #t))
(define false-value (lambda () #f))
(define true-value?
(lambda (x)
(not (eq? #f x))))
(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?)))
(if-exp
(test-exp expression?)
(true-exp expression?)
(false-exp expression?))
(cond-exp
(test-exps (list-of expression?))
(conseq-exps (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)
(equal?-prim)
(zero?-prim)
(greater?-prim)
(less?-prim)
(null?-prim)
)
(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)))
(if-exp (test-exp true-exp false-exp)
(let ((result (eval-expression test-exp env)))
(if (boolean? result)
(if (true-value? result)
(eval-expression true-exp env)
(eval-expression false-exp env))
(eopl:error 'if-exp "test-exp not eval'd to bool"))))
(cond-exp (test-exps conseq-exps)
(letrec
((cnd
(lambda (ts cs)
(if (or (null? ts) (null? cs))
(false-value)
(let ((result (eval-expression (car ts) env)))
(if (boolean? result)
(if (true-value? result)
(eval-expression (car cs) env)
(cnd (cdr ts) (cdr cs)))
(eopl:error 'cond-exp "test-exp not eval'd to bool")))))))
(cnd test-exps conseq-exps)))
)))
(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)
(equal?-prim () (if (= (car args) (cadr args))
(true-value)
(false-value)))
(zero?-prim () (if (= (car args) 0) (true-value) (false-value)))
(greater?-prim () (if (> (car args) (cadr args))
(true-value)
(false-value)))
(less?-prim () (if (< (car args) (cadr args))
(true-value)
(false-value)))
(null?-prim () (if (null? (car args)) (true-value) (false-value)))
)))
(define init-env
(lambda ()
(extend-env
'(emptylist i v x)
'(() 1 5 10)
(empty-env))))
(define scanner-spec-3-2
'((white-sp
(whitespace) skip)
(comment
("%" (arbno (not #\newline))) skip)
(identifier
(letter (arbno (or letter digit "?"))) symbol)
(number
(digit (arbno digit)) number)))
(define grammar-3-2
'((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
("cond" (arbno expression "==>" expression) "end")
cond-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 ("equal?") equal?-prim)
(primitive ("zero?") zero?-prim)
(primitive ("greater?") greater?-prim)
(primitive ("less?") less?-prim)
(primitive ("null?") null?-prim)
))
(define scan&parse
(sllgen:make-string-parser
scanner-spec-3-2
grammar-3-2))
(sllgen:make-define-datatypes scanner-spec-3-2 grammar-3-2)
(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-2
grammar-3-2))); Exercise 3.15
(load "r5rs.scm")
(load "define-datatype.scm")
(load "sllgen.scm")
(load "2-3-2.scm") ; for extend-env etc.
(define true-value (lambda () 1))
(define false-value (lambda () 0))
(define true-value?
(lambda (x)
(not (zero? x))))
(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?)))
(if-exp
(test-exp bool-exp?)
(true-exp expression?)
(false-exp expression?))
(cond-exp
(test-exps (list-of bool-exp?))
(conseq-exps (list-of expression?)))
)
(define-datatype bool-exp bool-exp?
(boolapp-exp
(prim bool-prim?)
(rands (list-of expression?)))
(boollit-exp
(datum number?))
(boolvar-exp
(id symbol?))
)
(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)
)
(define-datatype bool-prim bool-prim?
(equal?-prim)
(zero?-prim)
(greater?-prim)
(less?-prim)
(null?-prim)
)
(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)))
(if-exp (test-exp true-exp false-exp)
(if (true-value? (eval-bool-exp test-exp env))
(eval-expression true-exp env)
(eval-expression false-exp env)))
(cond-exp (test-exps conseq-exps)
(letrec
((cnd
(lambda (ts cs)
(cond
((or (null? ts) (null? cs)) (false-value))
((true-value? (eval-bool-exp (car ts) env))
(eval-expression (car cs) env))
(else
(cnd (cdr ts) (cdr cs)))))))
(cnd test-exps conseq-exps)))
)))
(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)
)))
(define eval-bool-exp
(lambda (exp env)
(cases bool-exp exp
(boolapp-exp (prim rands)
(let ((args (eval-rands rands env)))
(apply-bool-prim prim args)))
(boollit-exp (datum) datum)
(boolvar-exp (id) (apply-env env id))
)))
(define apply-bool-prim
(lambda (prim args)
(cases bool-prim prim
(equal?-prim () (if (= (car args) (cadr args))
(true-value)
(false-value)))
(zero?-prim () (if (= (car args) 0) (true-value) (false-value)))
(greater?-prim () (if (> (car args) (cadr args))
(true-value)
(false-value)))
(less?-prim () (if (< (car args) (cadr args))
(true-value)
(false-value)))
(null?-prim () (if (null? (car args)) (true-value) (false-value)))
)))
(define init-env
(lambda ()
(extend-env
'(emptylist i v x)
'(() 1 5 10)
(empty-env))))
(define scanner-spec-3-3
'((white-sp
(whitespace) skip)
(comment
("%" (arbno (not #\newline))) skip)
(identifier
(letter (arbno (or letter digit "?"))) symbol)
(number
(digit (arbno digit)) number)))
(define grammar-3-3
'((program
(expression)
a-program)
(expression
(number)
lit-exp)
(expression
(identifier)
var-exp)
(expression
(primitive "(" (separated-list expression ",") ")" )
primapp-exp)
(expression
("if" bool-exp "then" expression "else" expression)
if-exp)
(expression
("cond" (arbno bool-exp "==>" expression) "end")
cond-exp)
(bool-exp
(bool-prim "(" (separated-list expression ",") ")" )
boolapp-exp)
(bool-exp
(number)
boollit-exp)
(bool-exp
(identifier)
boolvar-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)
(bool-prim ("equal?") equal?-prim)
(bool-prim ("zero?") zero?-prim)
(bool-prim ("greater?") greater?-prim)
(bool-prim ("less?") less?-prim)
(bool-prim ("null?") null?-prim)
))
(define scan&parse
(sllgen:make-string-parser
scanner-spec-3-3
grammar-3-3))
(sllgen:make-define-datatypes scanner-spec-3-3 grammar-3-3)
(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-3
grammar-3-3)))
しかしここまでで前回から2ページしか進んでいないな。まあ気長にやるしかないか。
コメント 0