スタックマシンもどき

技術士試験の平成28年度情報工学部門に出題されたスタックマシンを Scheme で書く。
まずはスタックの実装から

(define nil '())

;; stack
(define *stack* nil)

(define (last-pushed)
  (if (empty?)
      nil
      (car *stack*)))

(define (after-popped)
  (if (empty?)
      nil
      (cdr *stack*)))

(define (init-stack)
  (set! *stack* nil))

(define (empty?)
  (null? *stack*))

(define (push x)
  (set! *stack* (cons x *stack*)))

(define (pop)
  (if (empty?)
      nil
      (let ((result (last-pushed)))
	(set! *stack* (after-popped))
	result)))

スタックマシンで使用する手続きの実装

(define (dup)
  (push (last-pushed)))

(define (sub)
  (let* ((a (pop))
         (b (pop)))
    (push (- b a))))

(define (cmp)
  (let* ((a (pop))
         (b (pop)))
    (= a b)))

(define (add)
  (let* ((a (pop))
         (b (pop)))
    (push (+ a b))))

(define (swap)
  (let* ((a (pop))
         (b (pop)))
    (push a)
    (push b)))

エラー処理は実装としては特に書きません。
間違えて使用するとエラーになるので適宜対処してください。
各手続きの仕様は問題にある説明の通りです。

(define (program)
  (define (loop1)
    (dup)
    (push 1)
    (sub)
    (dup)
    (push 1)
    (or (cmp) (loop1)))
  (define (loop2)
    (add)
    (swap)
    (dup)
    (push 5)
    (or (cmp) (loop2)))
  (init-stack)
  (push 5)
  (loop1)
  (loop2)
  (add))

スタックマシンで動作させるプログラム
これも問題の通り。Scheme ではラベルや goto は無いので loopN 手続きとして実装。

gosh> (program)
(15)

1 ～ 5 までを合計するプログラムなので、答えは 15。