(define (executor x stack)
  (cond ((equal? x '+)
         (cons (+ (car stack) (cadr stack)) (cddr stack)))
        ((equal? x '-)
         (cons (- (cadr stack) (car stack)) (cddr stack)))
        ((equal? x '*)
         (cons (* (cadr stack) (car stack)) (cddr stack)))
        ((equal? x '/)
         (cons (quotient (cadr stack) (car stack)) (cddr stack)))
        ((equal? x 'mod)
         (cons (remainder (cadr stack) (car stack)) (cddr stack)))
        ((equal? x 'neg)
         (cons (-(car stack)) (cdr stack)))
        ((equal? x '=)
         (if (= (cadr stack) (car stack))
             (cons -1 (cddr stack))
             (cons 0 (cddr stack))))
        ((equal? x '<)
         (if (< (cadr stack) (car stack))
             (cons -1 (cddr stack))
             (cons 0 (cddr stack))))
        ((equal? x '>)
         (if (> (cadr stack) (car stack))
             (cons -1 (cddr stack))
             (cons 0 (cddr stack))))
        ((equal? x 'not)
         (if (= (car stack) -1)
             (cons 0 (cdr stack))
             (cons -1 (cdr stack))))
        ((equal? x 'and)
         (if (and (= -1 (cadr stack) (= -1 (car stack))))
             (cons -1 (cddr stack))
             (cons 0 (cddr stack))))
        ((equal? x 'or)
         (if (or (= -1 (cadr stack) (= -1 (car stack))))
             (cons -1 (cddr stack))
             (cons 0 (cddr stack))))
        ((equal? x 'drop)
         (cdr stack))
        ((equal? x 'swap)
         (cons (cadr stack) (cons (car stack) (cddr stack))))
        ((equal? x 'dup)
         (cons (car stack) stack))
        ((equal? x 'over)
         (cons (cadr stack) stack))
        ((equal? x 'rot)
         (cons (caddr stack) (cons (cadr stack) (cons (car stack) (cdddr stack)))))
        ((equal? x 'depth)
         (cons (length stack) stack))
        (else #f)))

(define (def x c aslist)
  (cons (cons x (+ c 2)) aslist))

(define (struct x c v r s)
  (cond ((equal? x 'define)
         (if (equal? (vector-ref v c) 'end)
             (+ c 1)
             (struct x (+ c 1) v r s)))
        ((equal? x 'end)
         (+ (car r) 1))
        ((equal? x 'if)
         (if (= (car s) 0)
             (if (equal? (vector-ref v c) 'endif)
                 (+ c 1)
                 (struct x (+ c 1) v r s))
             (+ c 1)))
        ((equal? x 'endif)
         (+ c 1))
        ((equal? x 'exit)
         (+ (car r) 1))
        (else #f)))




(define (interpret vprog stack)
  (define (iter stack c rstack aslist)
    (cond
      ((= (vector-length vprog) c)
       stack)
      ((equal? (vector-ref vprog c) 'define)
       (iter stack (struct (vector-ref vprog c) c vprog rstack stack) rstack (def (vector-ref vprog (+ c 1)) c aslist)))
      ((equal? (vector-ref vprog c) 'end)
       (iter stack (struct (vector-ref vprog c) c vprog rstack stack) (cdr rstack) aslist))
      ((equal? (vector-ref vprog c) 'exit)
       (iter stack (struct (vector-ref vprog c) c vprog rstack stack) (cdr rstack) aslist))
      ((equal? (vector-ref vprog c) 'if)
       (iter (cdr stack) (struct 'if c vprog rstack stack) rstack aslist))
      ((= (vector-length vprog) c) stack)
      ((integer? (vector-ref vprog c))
       (iter (cons (vector-ref vprog c) stack) (+ c 1) rstack aslist))
      ((struct (vector-ref vprog c) c vprog rstack rstack)
       (iter stack (struct (vector-ref vprog c) c vprog rstack stack) rstack aslist))
      ((executor (vector-ref vprog c) stack)
       (iter (executor (vector-ref vprog c) stack) (+ c 1) rstack aslist))
      ((assq (vector-ref vprog c) aslist)
       (iter stack (cdr (assq (vector-ref vprog c) aslist)) (cons c rstack) aslist))))
  (iter stack 0 '() '()))


(interpret #( define abs
               dup 0 <
               if neg endif
               end
               9 abs
               -9 abs ) (quote ()))
;(9 9)

(interpret #( define =0? dup 0 = end
               define <0? dup 0 < end
               define signum
               =0? if exit endif
               <0? if drop -1 exit endif
               drop
               1
               end
               0 signum
               -5 signum
               10 signum ) (quote ()))
;(1 -1 0)

(interpret #( define — 1 - end
               define =0? dup 0 = end
               define =1? dup 1 = end
               define factorial
               =0? if drop 1 exit endif
               =1? if drop 1 exit endif
               dup —
               factorial
               *
               end
               0 factorial
               1 factorial
               2 factorial
               3 factorial
               4 factorial
               ) (quote ()))
;(24 6 2 1 1)

(interpret #( define =0? dup 0 = end
               define gcd
               =0? if drop exit endif
               swap over mod
               gcd
               end
               90 99 gcd
               234 8100 gcd ) '())
;(18 9)

(interpret #( define =0? dup 0 = end
               define =1? dup 1 = end
               define — 1 - end
               define fib
               =0? if drop 0 exit endif
               =1? if drop 1 exit endif
               — dup
               — fib
               swap fib
               +
               end
               define make-fib
               dup 0 < if drop exit endif
               dup fib
               swap —
               make-fib
               end
               10 make-fib ) (quote ()))
;(0 1 1 2 3 5 8 13 21 34 55)