ese-eval4 - ifzero (was 写経)

scheme

ifzeroを自前で追加してスタックの使われかたへの理解を深める。

@@ -24,6 +24,11 @@
     (name . begin)
     (args . ,args)))
 
+(define (make-ifzero  . args)
+  `((type . symbol)
+    (name . ifzero)
+    (args . ,args)))
+
 (define (make-func cont)
   `((type . func)
     (cont . ,cont)))
@@ -40,6 +45,9 @@
 (define (begin? exp)
   (eq? (assq-ref exp 'name) 'begin))
 
+(define (ifzero? exp)
+  (eq? (assq-ref exp 'name) 'ifzero))
+
 (define (ese-symbol? exp)
   (type-eq? exp 'symbol))
 
@@ -101,6 +109,29 @@
             ((eq? func 'resume)
              resume)))))
 
+(define (make-ifzero-cont row-args)
+  (let ((test '()) (result '()))
+    (lambda (func)
+;; optimized
+;;       (define (invoke-proc)
+;;         (if (null? test)
+;;             (make-need-sub-exp (list-ref row-args 0))
+;;             (make-tail (if (zero? test) (list-ref row-args 1) (list-ref row-args 2)))))
+
+;; not optimized
+      (define (invoke-proc)
+        (cond ((null? test)   (make-need-sub-exp (list-ref row-args 0)))
+              ((null? result) (make-need-sub-exp (if (zero? test) (list-ref row-args 1) (list-ref row-args 2))))
+              (else (make-int result))))
+      (define (resume retval)
+        (cond ((null? test) (set! test retval))
+              ((null? result) (set! result retval))))
+      (cond ((eq? func 'invoke-proc)
+             invoke-proc)
+            ((eq? func 'resume)
+             resume)))))
+
+
 (define (ese-eval exp)
   (let ((stack (make-queue)) (ret '()))
     (queue-push! stack exp)
@@ -114,6 +145,8 @@
         (queue-push! stack (make-func (make-flatten-cont (assq-ref exp1 'args) (cut fold + 0 <>)))))
        ((and (ese-symbol? exp1) (begin? exp1))
         (queue-push! stack (make-func (make-begin-cont (assq-ref exp1 'args)))))
+       ((and (ese-symbol? exp1) (ifzero? exp1))
+        (queue-push! stack (make-func (make-ifzero-cont (assq-ref exp1 'args)))))
        ((func? exp1)
         (queue-push! stack exp1)
         (let ((res (((assq-ref exp1 'cont) 'invoke-proc))))
@@ -130,6 +163,7 @@
           (loop (dump-queue stack) (queue-pop! stack))))))
 
 (ese-eval (make-begin (make-begin (make-int 5) (make-begin (make-int 3) (make-int 10))) (make-int 12)))
+(print (ese-eval (make-ifzero (make-add (make-int 1) (make-int -1)) (make-int 1) (make-int 2))))
 
 ;; (test-start "ese-eval")
 ;; (test* "eval int" 10 (ese-eval (make-int 10)))