個人用電卓のプログラミング

またThe Art of Happy Hacking Calculator Programmingの話だ. 2年ほど前のこのブログに, 私のデザインしたHappy Hacking Calculatorのプログラミングの話を何回か書いた. 例えば1から10までの和のプログラムは,

(0Ua"N+U1-"_aG^N)X=

factorialは

("_6_G1+5_"G"1-!*)!=

という具合いである. Gの命令について復習すると, スタックの上から2段目の内容が負なら, プログラム制御をスタック最上段の数だけバックする(左へ進む), 非負ならそのまま進むというのであった. そこで, プログラムを書くのに面倒なのは, 飛び先までの長さの計測である. factorialのプログラムの左から5文字目のGはスタックの最上段に-6があるので, その下が負なら, 右へ(1+5_"G)の6文字を飛び越えることを示す. つまり右のGの次の"のところだ. 当時のプログラムでは, 長さのところを空けておき, 他が出来てから手作業で長さを数えていた.



またこの図の左のようだと, G命令から10文字左へ飛び, 右のようだと9文字左へ行く. それが同じ場所である. 従って, 工夫によってはプログラムが短く出来る.

これをなんとか自動化したい, つまりコンパイラを書きたいとかねがね考えていた.

飛び先までの間に条件付きのbranch命令や無条件のjump命令があると, そのパラメータの文字数が未定であったりするので, 自縄自縛(という表現が適切かな)になり, コンパイラの書き方が決らなかった.

最近, 思いついた方法があり, それでプログラムを生成してみたが, なんとかなりそうである. そのことを書きたい.

コンパイルされるプログラムはこんな形をしている.

(define sum '(0 up 10 'foo dup down + up 1 - dup neg
 (branch foo) pop down 'exit))

(define factorial
'(dup neg (branch bar) 1 ent (branch exit) 'bar
 dup 1 sub ! * 'exit))

(define ackermann '(
dup 1 - (branch a) exch dup 1 - (branch b)
exch dup 2 - (branch c)
up dup 1 - exch down 1 - A A (jump exit)
'c pop pop 2 ent (jump exit)
'b pop 2 * (jump exit)
'a pop pop 0
'exit
))

sumが10までの和のプログラムで, クォートされているリスト内がプログラム本体である. 0とか10は定数で, そのまま文字に置き換わる. 今の版ではコンパイラの関数によって十進だったり十六進数だったりする. up, dup, down, +, -, negなどが, プログラムの命令だ. (このAckermann関数は, SICPのex1.10にあるものだ.)

(branch foo)はfooへのbranch命令を挿入することを示す. その飛び先は'fooのところである. jump命令では, スタックの判定用に無理に負の数をおいて常に飛ぶのである.



それぞれの図の箱は, 長さ固定のプログラム. その間のb_mやその間j_mはbranchやjump命令. 矢印はそこから飛ぶ飛び先で, l_nは飛ぶ長さである.
b_mやj_mは, 対応する飛ぶ距離l_nの文字に変換した長さlに,

a. 左へのbranchはlの次にGの1文字,
b. 右へのbranchはlの次に_とGの2文字,
c. 左へのjumpは1_の2文字とlの次にGの1文字,
d. 右へのjumpはlの次に_"Gの3文字
をつける. つまり追加文字数は, a, b, c, dのそれぞれで, 1, 2, 3, 3である.

ackermannのプログラムは, 二進十進(あるいは十六進)変換を

(define (f n)
 (if (< n 10) 1 (if (< n 100) 2 3)))

と定義し,

(define b0 0)
(define b1 0)
(define b2 0)
(define j0 0)
(define j1 0)
(define j2 0)

(define (iter)
 (let* ((l0 (+ 4 b1 4 b2 10 j0 4 j1 3 j2))
        (l1 (+ 4 b2 10 j0 4 j1))
        (l2 (+ 10 j0))
        (l3 (+ 4 j1 3 j2 3))
        (l4 (+ 3 j2 3))
        (l5 3)
        (c0 (+ (f l0) 2))
        (c1 (+ (f l1) 2))
        (c2 (+ (f l2) 2))
        (k0 (+ (f l3) 3))
        (k1 (+ (f l4) 3))
        (k2 (+ (f l5) 3)))
(if (equal? (list c0 c1 c2 k0 k1 k2) (list b0 b1 b2 j0 j1 j2))
    (list b0 b1 b2 j0 j1 j2 l0 l1 l2 l3 l4 l5)
    (begin (set! b0 c0) (set! b1 c1) (set! b2 c2)
           (set! j0 k0) (set! j1 k1) (set! j2 k2) (iter)))))

のプログラムで(iter)とすると,

 (4 4 4 5 5 4 47 32 15 19 10 3)

が得られる. したがってb₀は47_G, b₁は 32_G, b₂は15_G, j₀は 19_"G, j₁は10_"G, j₂は 3_"G となる.

facotorialは

(define (iter)
(let* ((l0 (+ 2 b1))
       (l1 5)
       (c0 (+ (f l0) 2))
       (c1 (+ (f l1) 2)))
(if (equal? (list c0 c1) (list b0 b1))
    (list b0 b1 l0 l1)
    (begin (set! b0 c0) (set! b1 c1) (iter)))))

で,

(3 3 5 5)

が得られるから, b₀は 5_G, b₁も 5_G でよい.

10までの和は,

(2 9)

が得られ, b₀はすなわち9Gとなる.

以上は, それぞれの関数用のプログラムを実行した例だが, プログラムの半ばコンパイルした中間出力のリストを使うことも出来るようになった.

ackermann関数の例では, b_mやj_mをリストにし, プログラムのブロックをその長さl_nで置き換えた中間出力

((3 "\"1-") (b a 0 0) (4 ":\"1-") (b b 0 0) (4 ":\"2-") (b c 0 0)
 (10 "U\"1-:N1-AA") (j exit 0 0) c (4 "^^2E") (j exit 0 0)
 b (3 "^2*") (j exit 0 0) a (3 "^^0") exit))

から

"1-47_G:"1-32_G:"2-15_GU"1-:N1-AA19_"G^^2E10_"G^2*3_"G^^0

を得るプログラムは走るようになっているが, まだ改善の余地だらけで, 公開ははばかられる.

個人用電卓のプログラミング

今年の3月頃にこのブログに投稿した, 電卓HHCのプログラミングの話題の続きである. この電卓のシミュレータには, スタックが2個あり, その間でデータが受け渡せる. このスタックを, 両方へ延びるテープ, 命令UとNをヘッドの右, 左への移動と思うと, 2スタックモデルはTuring Machineに非常によく似てくる.

そこで今回は, Turing Machineをシミュレートしてみた.

Turingの1936年の有名な論文の始めの方に, テープに0010110111011110...を書く例がある.

つまり, 0の列の間に1を0個, 1個, 2個, 3個, ...と挟むのである. この論文のテープは, 計算結果を書くますと, 作業用の記号を書くますが, 交互に並んでいる. 従って, 上の出力も,テープ全体で見ると, bを空白のますとして, 0b0b1b0b1b1b0b1b1b1b0b1b1b1b1b0...と出来上がる.

Turingのプログラムは以下のようである. (状態bにPe, つまりeを書くとあるが, Turingの論文では, eを上下反対にした形である.)

state symbol   operations               next state

b              Pe,R,Pe,R,P0,R,R,P0,L,L  o

o      1       R,Px,L,L,L               o
       0                                q

q     0or1     R,R                      q
      none     P1,L                     p

p      x       E,R                      q
       e       R                        f
      none     L,L                      p

f      0or1    R,R                      f
      none     P0,L,L                   o

開始の状態はbで, 「eを書き右へ行きeを書き右へ行き0を書き右へ行き右へ行き0を書き左へ行き左へ行き」だから, テープは「ee0 0」となり, ヘッドは左の0のところにあって, 新しい状態はo.

状態oは, 結果のますで, 左へ1が続く限り, その右に作業用のxを書く. 0であったら, 0の場所にいるままで, 状態qへ. 従って, 最初はすぐqになる.

状態qでは, 結果のますに0が1がある限り右へ行き, 空白を見つけたら1を書き, 左へ進み(つまり作業ますに移り), pになる.

pでは, 作業用のますを左に見て生き, xに出会えば, それを消してqになるから, 右の空白に1を書きpに戻る. つまりxの数だけ, 右に1を書く. その前に, oからqに移ってきた時にも1を書いたから, xの数より1個多く1を書く. xが見つからず, 左端のeが見つかれば, 右に行き, 結果のますに移ってfになる.

状態fでは結果のますを右に見ていき, 空白を見つけたら0を書き, 左へ2歩行き, 1の真下にいて, oに戻る.

oは前に述べた通り, 1が続くとxを併記していき, 次回1を書き続ける時の準備をする.

とりあえずSchemによるシミュレーションはを下に示す. テープ長は50で, それを越えて読み書きしようとすれば, プログラムを修了する. 記号e, x, 空白を, 2, 3, 4で表現する.

(define e 2) (define x 3) (define n 4)
(define tapelength 50)
(define tape (make-vector tapelength n))
(define i 0)

(call-with-current-continuation
 (lambda (throw)

   (define (put x) (if (< i tapelength)
    (vector-set! tape i x) (throw 'ok)))
   (define (get) (if (< i tapelength) (vector-ref tape i)
    (throw 'ok)))
   (define (r) (set! i (+ i 1)))
   (define (l) (set! i (- i 1)))
   (define (eraze) (put n))
   (define (b)
    (put e)(r)(put e)(r)(put 0)(r)(r)(put 0)(l)(l)(o))

   (define (o) ;状態o
    (let ((c (get)))
     (if (= c 1) (begin (r)(put x)(l)(l)(l)(o))
      (if (= c 0) (q)))))

   (define (q) ;状態q
    (let ((c (get)))
     (if (or (= c 0) (= c 1)) (begin(r)(r)(q))
      (begin (put 1)(l)(p)))))

   (define (p) ;状態p
    (let ((c (get)))
     (if (= c x) (begin (eraze)(r)(q))
      (if (= c e) (begin (r)(f))
       (begin (l)(l)(p))))))

   (define (f) 状態f
    (let ((c (get)))
     (if (or (= c 0) (= c 1)) (begin (r)(r)(f))
      (begin (put 0)(l)(l)(o)))))

      (b)))

(define (printtape)  ;テープを文字列にする. (0 0 1 4 2 3)
 (let ((t (vector->list tape)))  ;=>"001 ex"
  (display (list->string
   (map (lambda (c)
    (cond ((= c 4) #\space) ((= c 0) #\0)
          ((= c 1) #\1) ((= c 2) #\e)
          ((= c 1) #\1) ((= c 2) #\e)
          ((= c 3) #\x))) t)))))

最後のprinttapeは, 記号のリストを文字列に変換する. throwで飛び出した時のテープは

 (printtape)
ee0 0 1 0 1 1 0 1 1 1 0 1 1 1 1 0 1x1x1x1 1 0 1 1

qで3つめの1を書こうとした時, 配列の範囲を飛び出したことが分かる.

さて, これを電卓プログラムに書き直す. 元の状態名には, 電卓プログラムでは使えない文字もあるので, b,o,q,p,fをそれぞれg,h,i,j,kとする. そして出来たプログラムは次のとおり. 最初のtはテープに相当する2つのスタックを用意する. スタックの底を示すため, -1を置く. スキャンするヘッドの下には, 空白を置く. rとlはヘッドを右や左に動かす. つまりrはU, lはNなのだが, 底を突き抜けないようなチェックが必要である. PやEもpやxとして実装した.

(1_"U4)t= ;Turing Machine Initialize
(U"4_G2_"G4E)r= ;Move Right
(N"4_G3_"GU4E)l= ;Move Left
(^)p= ;print a letter    ap
(4p)x= ;erase    print blank

状態b, o, q, p, fはそれぞれサブルーチンg, h, i, j, kとして, 定義する. セミコロンから右は, コメントである. プログラムの上の0や1やnoneは, その条件でジャンプする; またはジャンプからここに飛び込むというような, コメントである.

(2pr2pr0prr0pllh)g= ;b Pe,R,Pe,R,P0,R,R,P0,L,L ->o
;     1    0
("_5_Gi7_"Gr3plllh)h= ;o 1 R,Px,L,L,L -> o 0 ->q
;      none     none
("_1+7_Grri4_"G1plj)i= ;q 0 or 1 R,R -> q none P1,L ->p
;    01      e     x01    e     x
("2-c_G"3-d_G"4-d_Gllj9_"Grk3_"Gxri)j= 
;p x E,R ->q e R ->f none L,L->p
;       none
("_1+7_Grrk5_"G0pllh)k= ;f 0 or 1 R,R ->f none P0,L,L -> o

1を４個, その右に0を1個書いた直後のテープの状態(つまりスタック)は下のとおり.

(-1 2 2 0 4 0 4 1 4 0 4 1 4 1 4 0 4 1 4 1 4 1 4 0
   4 1 4 1 4 1 4)(1 4 0 -1)

両端の-1はテープの終りだ. 左スタックの底には最初に書いたeeに相当する22が見える. その後, 空白を示す4を飛ばして読めば, 0010110111011110になっている. 0を書いてからヘッドが左へ2回動いたので, ヘッドの位置はスタックトップの1のところである.

分かってみると, Turingの元のプログラムを, 無駄がないのがよく分かった. また個人用電卓も, 2スタックモデルにすると, こんなことまで出来るということが見えた.

個人用電卓のプログラミング

情報科学標準問題の1つにfactorialがある.

(define (factorial n)
  (if (= n 0) 1
      (* n (factorial (- n 1)))))

個人用電卓のプログラムでも, この程度のことはやってみたい. プログラム名としては「!」を使うことにしよう.

nがスタックトップにあるとき, これを複製し, 1を引き, !でfactorialをとり, *で掛ければよい. 問題はnが0の時には1を返す仕掛けを組み込むことである. 0と1以上の判定は, 符号を反転して負になれば元は≥1であったわけだ.

従ってプログラムはこうなる.

("_6_G1+5_"G"1-!*)!=
      0123456
            012345

このプログラムの開始時, nを複製し, 符号反転する. その上に-6を置き, ジャンプの準備をする. G命令で6文字右へ飛ぶ. プログラムの下のGの隣りから012...とあるのが飛び先で, 次のGの右の"まで行く. そこで複製し, 1を引き!でfactorialを再帰呼出しする. n-1のfactorialがとれて戻ってきたら, *で掛ける. 一方0だったら, Gではジャンプせず, n(つまり0)に1を足し, 返す値1を作る. 次に-5を2個積んでG命令でプログラムの終りまで飛ぶ. -5を2個置くのは, 上は飛び先, 下は負ジャンプを絶対ジャンプにするためである.

factorial 3の実行の様子は下の図の通り.



一番左はGからの相対位置. 次は命令. (3)から始まる列は最初の実行トレース. G命令で下へ飛ぶ. そのうち, !命令になると, 次に右の列の"からfactorialを再帰実行する.

3回目の再帰実行は, スタックが0の時で, 処理の流れが異る. つまりG命令でジャンプせず, 1を置いて(正しくは0に1を足して)飛び出す.

戻ると1つ左の最下行*に来, 1と1を掛け1にして飛び出す. また左の最下行*で1と2を掛け, 次の左で2と3を掛け, 結果は6になった.

個人用電卓のプログラミング

昨年10月頃, このブログに書いた個人用電卓は, 機能を拡張したヴァージョンが, シミュレータ上で快適に稼働している.

今回はそのプログラミング技法を紹介する.

Schemeで書いたシミュレータは, スタックの代りにリストを使う. car側がスタックトップである. 電卓実機はスタックを突き破ってポップも出来るが, リストではそうはいかぬ. また実機は2の補数の64ビットであったが, シミュレータはbignumである.

シミュレータには押しボタンはないから, それに相当する文字を決める.
0〜9は文字も0〜9.
十六進のA,B,...,Fは小文字でa,b,...,f.
算術演算+,-,*,/はそのまま.
基数変換Hex, Dec, OctはH,D,O.
数値を区切るEntはE.
Pop, Dup, Exc, Chsはそれぞれ ^,",:,_.
Sqt, Fct, Pow, JDはそれぞれS,F,P,Jである.

従って3*(2+1)は, 3E2E1+* と入力する. リターンは無視.

拡張機能には, まず補助スタックが出来た. これも実態はリストである.
命令は2個

U スタックをポップし, そこにあったものを補助スタックにプッシュする.
N 補助スタックをポップし, そこにあったものをスタックにプッシュする.

こうすることで, 例えばスタックトップの4個を回転する:
:U:U:NNで(d c b a ...)を(c b a d ...)とすることが出来る. まず:でスタックは(c d b a ...)になる; Uでcは補助スタックへ移り, (... c) (d b a ...)になる. 左側にあるリストが補助スタックで, スタックトップが右に書いてある. 2番目の:でスタックは(b d a ...)になり, Uで(... c b) (d a ...)になり, 3番目の:で(a d ...)になり, NNで(... ) (c b a d ...)になるのである.

こんなことをやっている内に, このプログラム列を記憶し, 繰り返し使いたくなった. そこで (:U:U:NN)R= と入力して, プログラム列をRという名前で記憶する. Rで(d c b a ...)が(c b a d ...)になるので, RRRとすると(d c b a ...)がこの4段の回転を3回実行し, (a d c b ...)になるのである.

さらに欲が出てきて, プログラムの中で条件ジャンプがしたくなった.

G スタックのトップから2段目が負なら, スタックトップの数だけプログラムを戻る.

10から1までの和を計算するプログラムは次のようだ.

(0Ua"N+U1-"_aG^N)X=

と定義し, Xで起動する. 実行の様子は下の通り.



上の図では, 左の方に命令が縦に並べてある. 一番左の下から0,1,...とあるのは, G命令でジャンプする相対番地である. 10回目でループを抜けると, 主のスタックトップに和の55が出来ている.

ここまで来れば鬼に鉄棒である. もっと難しいプログラムの例はまた次回に.