EoPL reading (137) 3.2 The Front End

とりあえず練習問題に手を付けてみます。

Exercise 3.3

eva-program 手続きがマトモに動けば良いはず。sllgen が不要なのでこちらを先に、な easy さをご容赦頂ければ幸いです。
ええと前提になるプログラム群を以下に。
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))
	   )))

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

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))

で、これを前提に parse をでっち上げてみる。まず、lit-exp についてどの述語を使えば良いのかを検討。
とりあえず現時点で数値演算のみ、なので number? が真なら lit-exp か。あるいは symbol? なら var-exp にしておきます。あとは pair? が真なら primapp-exp って事にしておきます。凄い easy だけど。
で、でっち上がったのが以下なんですが

(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 (map (lambda (x) (parse-expression x)) datum))))))

これって多分ダウト。primitive が微妙。ちょっと今日はタイムアップです。