Scheme - レジスタ計算機での計算(レジスタ計算機の設計(レジスタ計算機シミュレータ))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著)ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著)Julie Sussman (原著)
Gerald Jay Sussman (原著)和田 英一 (翻訳)

開発環境

• OS X Yosemite - Apple (OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の5(レジスタ計算機での計算)、5.2(レジスタ計算機シミュレータ)、、問題 5.7.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
• Scheme手習い

問題 5.7.

コード(BBEdit, Emacs)

sample7.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

(load "./regsim.scm")
(load "./assemble.scm")
(load "./compound_procedures.scm")
       
(define expt-machine-1
  (make-machine
   '(continue n b val)
   (list (list '= =) (list '- -) (list '* *))
   '((assign continue (label expt-done))
     expt-loop
     (test (op =) (reg n) (const 0))
     (branch (label base-case))
     (save continue)
     (save n)
     (assign n (op -) (reg n) (const 1))
     (assign continue (label after-expt))
     (goto (label expt-loop))
     after-expt
     (restore n)
     (restore continue)
     (assign val (op *) (reg b) (reg val))
     (goto (reg continue))
     base-case
     (assign val (const 1))
     (goto (reg continue))
     expt-done)))

(print (set-register-contents! expt-machine-1 'b 2))
(print (set-register-contents! expt-machine-1 'n 10))
(print (start expt-machine-1))
(print (get-register-contents expt-machine-1 'val))

(define expt-machine-2
  (make-machine
   '(product counter n b)
   (list (list '= =) (list '- -) (list '* *))
   '((assign counter (reg n))
     (assign product (const 1))
     expt-loop
     (test (op =) (reg counter) (const 0))
     (branch (label expt-done))
     (assign counter (op -) (reg counter) (const 1))
     (assign product (op *) (reg b) (reg product))
     (goto (label expt-loop))
     expt-done)))

(print (set-register-contents! expt-machine-2 'b 2))
(print (set-register-contents! expt-machine-2 'n 10))
(print (start expt-machine-2))
(print (get-register-contents expt-machine-2 'product))

入出力結果(Terminal(gosh), REPL(Read, Eval, Print, Loop))

$ ./sample7.scm 
done
done
done
1024
done
done
done
1024
$