写経

某氏がJavaScriptで書いたコードをScheme(Gauche)で写経。

native stack版

(use util.list)
(use gauche.test)

(define (make-int i)
  `((type . int)
    (value .  ,i)))

(define (make-add  . args)
  `((type . add)
    (args . ,args)))


(define (ese-eval exp)
  (cond ((eq? (assq-ref exp 'type) 'int)
         (assq-ref exp 'value))
        ((eq? (assq-ref exp 'type) 'add)
         (+ (ese-eval (car (assq-ref exp 'args)))
            (ese-eval (cadr (assq-ref exp 'args)))))
        (else
         (print "not reached"))))

(test-start "ese-eval")

(test* "eval int" 10 (ese-eval (make-int 10)))
(test* "(add 10 12)" 22 (ese-eval (make-add (make-int 10) (make-int 12))))
(test* "(add 10 (add 1 3))" 14 (ese-eval (make-add (make-int 10)
                                                   (make-add (make-int 1) (make-int 3)))))
(test-end)

native stackじゃない版

(use util.list)
(use gauche.test)
(use util.queue)

(define (make-int i)
  `((type . int)
    (value .  ,i)))

(define (make-add  . args)
  `((type . add)
    (args . ,args)))

(define (make-cont  need-eval cont-proc exp)
  `((type      . cont)
    (need-eval . ,need-eval)
    (cont      . ,cont-proc)
    (exp       . ,exp)))

(define (type-eq? exp type)
  (eq? (assq-ref exp 'type) type))

(define (int? exp)
  (type-eq? exp 'int))

(define (cont? exp)
  (type-eq? exp 'cont))

(define (add? exp)
  (type-eq? exp 'add))


(define (ese-eval exp)
  (let ((stack (make-queue)) (ret '()))
    (queue-push! stack exp)
    (let loop ((exp1 (queue-pop! stack)))
      (cond
       ((int? exp1)
        (set! ret (assq-ref exp1 'value)))
       ((add? exp1)
        (queue-push!
         stack
         (make-cont
          #f
          (lambda (second)
            (make-cont #t
                       (lambda (first-arg) (make-int (+ second first-arg)))
                       (car (assq-ref exp1 'args))))
          '()))
        (queue-push! stack (cadr (assq-ref exp1 'args))))
       ((cont? exp1)
        (let ((res ((assq-ref exp1 'cont) ret)))
          (cond ((assq-ref res 'need-eval)
                 (queue-push!
                  stack
                  (make-cont #f (lambda (arg) ((assq-ref res 'cont) arg)) '()))
                 (queue-push! stack (assq-ref res 'exp)))
                ((int? res)
                 (set! ret (assq-ref res 'value)))))))
      (if (zero? (queue-length stack))
          ret
          (loop (queue-pop! stack))))))

(test-start "ese-eval")
(test* "eval int" 10 (ese-eval (make-int 10)))
(test* "(add 10 12)" 22 (ese-eval (make-add (make-int 10) (make-int 12))))
(test* "(add 10 (add 1 3))" 14 (ese-eval (make-add (make-int 10)
                                                  (make-add (make-int 1) (make-int 3)))))
(test-end)

よくよく見ると Named Let はループじゃないので native スタック使うよね。
いやいや結局末尾再帰だから。。みたいな話はおいておいて。

頭が悪いのでまだ完全には理解できていない。
同じものを1週間後に3分で書けといわれたら絶対無理＞＜。