Christopher StracheyのGPM

順列の生成

n個の要素のすべての順列を生成するのも情報科学標準問題である.

私のSchemeのライブラリには

(define (permutation ls) ;list of permutation of ls
 (define (list-del l n)
   (if (= n 0) (cdr l)
    (cons (car l) (list-del (cdr l) (- n 1)))))
  (if (null? ls) '(())
   (apply append (map (lambda (i)
    (let ((x (list-ref ls i)))
     (map (lambda (p) (cons x p))
       (permutation (list-del ls i))  )))
      (a2b 0 (length ls))))))
;(permutation '(a b c))=>
;((a b c) (a c b) (b a c) (b c a) (c a b) (c b a))

というのが置いてある.

(list-del l n)はlのn番目の要素を取り去ったリストを返す. 本体は順列をとるリストが空なら空リストのリストを返す. そうでないなら最後の行(a2b 0 (length ls))でlsが(a b c)なら(0 1 2)のリストを作り, その各々を(lambda (i)..)のiとして(let..以下をやったものをappendする.

(let以下のxはlist-refだからa,b,cになり, それぞれlist-delした(b c) (a c) (a b)の順列の先頭に付ける. だから(a b c) (a c b) (b a c) (b c a) (c a b) (c b a)をappendすることになり, (a b c)の順列が完成する.

さてgpmには配列もリストもないから, また引数列を活用するプログラムを考えなければならない. 引数の長さに従って別のマクロを用意しなければならない.

そう考えて書いたのが次だ.

$def,p2,<~1~2~3>;
$def,p3,<$p2,~1,~2,~3;
$p2,~1,~3,~2;>;
$def,p4,<$p3,~1~2,~3,~4;
$p3,~1~3,~2,~4;
$p3,~1~4,~2,~3;>;
$def,p5,<$p4,~1~2,~3,~4,~5;
$p4,~1~3,~2,~4,~5;
$p4,~1~4,~2,~3,~5;
$p4,~1~5,~2,~3,~4;>;

これはまずp5を$p5,,a,b,c,d;のように呼ぶ. 第1引数が空, 第2引数以降がa,b,c,d である.

そこでp5の定義を見ると, $p4,空a,b,c,d;$p4,空b,a,c,d;$p4,空c,a,b,d;$p4,空d,a,b,c;とp4を呼び出している. つまりp4の第1引数は上のSchemeのプログラムのx, 以降はlist-delの結果に対応している.

p4の定義を見ると, $p3,~1~2,~3,~4;と呼ぶから, 最初のp4の呼出からは$p3,空ab,c,d;$p3,空ac,b,d;$p3,空ad,b,c;と呼出され, その最初のp3の呼出では$p2,空ab,c,d;$p2,空ab,d,c;と呼出され, p2によってabcd, abdcと出力される.

なんだか全部の順列を自分で書いたみたいな気もするが, これで完成である. 引数の数だけマクロを用意するのは面倒だが, それを我慢すれば存外簡単であった.

Christopher StracheyのGPM

クィーンパズル生成マクロ

前回は4クィーン問題をGPMで解いてみたが, そもそもは8クィーンを解きたい.

すこし時間が経ったのでおさらいするとして, q2とq3を並べて見る.

$def,q3,<$z,0,                  $def,q2,<$y,0,                  
 $def,z,<$~1,                    $def,y,<$~1,                   
 $def,~1,<$                      $def,~1,<$                     
  $|,$?,>>~1<<,>~1<,0;,           $|,$?,>>~1<<,>~1<,0;,         
  $|,$?,>>~1<<,>~1<,3;,           $|,$?,>>~1<<,>~1<,2;,         
  $|,$?,>>~2<<,>~1<,0;,           $|,$?,>>~2<<,>~1<,0;,         
  $|,$?,>>~2<<,>~1<,2;,           $?,>>~2<<,>~1<,1;;;;,         
  $|,$?,>>~3<<,>~1<,0;,                                         
  $?,>>~3<<,>~1<,1;;;;;;,                                       
  $def,f,<$q4,>>>~1<<<,>>>~2<<<,  $def,f,<$q3,>>>~1<<<,>>>~2<<<,
   >>>~3<<<,>>~1<<,>>>~4<<<;       >>~1<<,>>>~3<<<;             
   $z,$1+,>>~1<<;;>;,              $y,$1+,>>~1<<;;>;,           
  $def,t,<$z,$1+,>>~1<<;;>;;>;,   $def,t,<$y,$1+,>>~1<<;;>;;>;, 
 $def,>~4<,;;>;;>;               $def,>~3<,;;>;;>;              

q2は$q2,0,2,4; $q2,0,3,4; のように既に2個のクィーンが無事に置けたとしてそれらのクィーンの位置と4クィーンであるという4をもって呼ばれる. 3個めを0,1,2,3と置いてみて, うまく置ければそれを次の引数に追加してq3を呼ぶ仕掛である.

3個めを置くマクロはyで, $y,0;と呼ぶ. 続けてyの定義がある. まず引数が~3, つまりnクィーンのnなら終りのチェックをするが, 例によってelseから書いてある. else節はor(|)で$?をいくつも呼んで, 引数で持ち込まれたクィーンと当るかを調べる.

$?,>>~1<<,>~1<,0;は最初のクィーンと今度のクィーンが横並びか見る. (>>~1<<が最初のクィーン, >~1<がyが作った新しいクィーン.) 次の?はクィーンが横方向に2ずれているから, 高さ方向の差が2であるか見る.

次は2番目のクィーンと今度のクィーンが横並びか高さの差が1かを見る.

orが偽をいうことは, 無事に置けたのだから, 受け取った引数と, 今回テスト中のクィーンとnの値4をもってq3を呼び, 今回のクィーンの位置をひとつ増してyを呼ぶ.

新しい位置が当っていれば, $def,t,にあるように, 位置を増してyを呼ぶ.

新しいクィーンの位置がnまで来ると最後の方の$def,>~3<,で, そのまま脱出してしまう.

これが別れば一般のクィーンの個数のqマクロが書ける.

しかしマクロを生成するマクロには宿命がある. 評価を阻止する<と>について, 出力マクロに入れるものか, 現状の評価中に評価を阻止するためのものか, 区別が必要なことである.

今回は出力に書き出すものは, [と]を使うことにした. 出来上がったマクロをエディタで処理し, [,]を<,>に置き換える.

$def,g0,<$~1,
$def,~1,<
<  $|,$?,]]~>$-,>~2<,>~1<;<[[,]~1[,0;,>
<  $|,$?,]]~>$-,>~2<,>~1<;<[[,]~1[,>>~1<<;,>
    $g0,$1-,>~1<;,>~2<;>;,
$def,1,<
<  $|,$?,]]~>$-,>~2<,>~1<;<[[,]~1[,0;,>
<  $?,]]~>$-,>~2<,>~1<;<[[,]~1[,>>~1;;>;
$def,g1,<$~1,
$def,~1,<;;$g1,$1-,>~1<;;>;,
$def,0,;;>;
$def,g2,<$~1,
$def,~1,<<]]]~>$-,>~2<,>~1<;<[[[,>
   $g2,$1-,>~1<;,>~2<;>;,
$def,0,;;>;

$def,gen,<
<$def,q>~1<,[$>~2<,0,>
< $def,>~2<,[$~1,>
< $def,~1,[$>$g0,~1,$1+,~1;;$g1,~1;<,>
<   $def,f,[$q>$1+,~1;<,>
  $g2,~1,$1+,~1;;<]]~1[[,]]]~>$1+,~1;<[[[;>
<   $>~2<,$1+,]]~1[[;;];,>
<  $def,t,[
$>~2<,$1+,]]~1[[;;];;];,>
< $def,]~>$1+,~1;<[,;;];;];>
>;

この$genが生成マクロである. $gen,3,z;のように呼ぶ. するとq3が出力される. zは上のq2の例にあったyの働きのものである.

真中より少し下のgenの定義を見ると,

<$def,q>~1<,[$>~2<,0,>
< $def,>~2<,[$~1,>
< $def,~1,[$>

とあって, これで

$def,q3,[$z,0,
 $def,z,[$~1,
 $def,~1,[$

までが出来る. 次のg0はorの連続を出力, g1はその後のセミコロンの列を出力する. さらに先のg2はq4の呼出し列を生成する. そういう次第で出力されたq3は

$def,q3,[$z,0,
 $def,z,[$~1,
 $def,~1,[$
  $|,$?,]]~1[[,]~1[,0;,
  $|,$?,]]~1[[,]~1[,3;,
  $|,$?,]]~2[[,]~1[,0;,
  $|,$?,]]~2[[,]~1[,2;,
  $|,$?,]]~3[[,]~1[,0;,
  $?,]]~3[[,]~1[,1;;;;;;,
   $def,f,[$q4,]]]~1[[[,]]]~2[[[,]]]~3[[[,]]~1[[,]]]~4[[[;
   $z,$1+,]]~1[[;;];,
  $def,t,[$z,$1+,]]~1[[;;];;];,
 $def,]~4[,;;];;];

ほかのq1,q2,...,q7も以下の呼出しで生成される.

$gen,7,d;
$gen,6,c;
$gen,5,b;
$gen,4,a;
$gen,3,z;
$gen,2,y;
$gen,1,x;

その出力のかっこを変換し, 両端の

$def,q8,<~1,~2,~3,~4,~5,~6,~7,~8;>;
$def,q0,<$w,0,
 $def,w,<$~1,
 $def,~1,<$q1,>~1<,>>~1<<;
  $w,$1+,>~1<;;>;,
 $def,>~1<,;;>;;>;

を追加し, $q0,8; で呼ぶと, 約28分の実行の後

0,4,7,5,2,6,1,3;0,5,7,2,6,3,1,4;
0,6,3,5,7,1,4,2;0,6,4,7,1,3,5,2;
1,3,5,7,2,0,6,4;...
...
7,2,0,5,1,4,6,3;7,3,0,2,5,1,6,4;

が得られた. 結構大騒ぎだが, もう何クィーンでも対応できるようになった. もっとも引数の個数の制限は別である.

Christopher StracheyのGPM

4クィーンパズル

バックトラックしながら全解探索する情報科学標準問題である. 普通の言語なら配列を使うわけだが, GPMでやってみようと思うと, 配列がないのでまず困る.

今回は部分解を引数の列で持ち回ることにした. つまりnクィーンを解くとしてマクロq0は第0列のs=0,1,..,n-1にクィーンを置き, sを引数としてq1を呼ぶ. q1は第1列のt=0,1,..,n-1のクィーンがsと当たっていなければ, s,tを引数としてq2を呼ぶ. ... のように作る.



クィーン同士が当るかどうかみるのにマクロ$?,a,b,d;を用意する. a,bがd離れているかみるもので, Schemeで書けば

(define (? a b d) (= (abs (- a b)) d))

となる.

$def,1+,<$1,2,3,4,5,6,7,8,9,10,
 $def,1,<~>~1;;>;
$def,1-,<$-1,0,1,2,3,4,5,6,7,8,
 $def,-1,<~>~1;;>;
$def,-,<$~2,
 $def,~2,<$-,$1-,>~1<;,$1-,>~2<;;>;,$def,0,~1;;>;
$def,lt,<$~1,
 $def,~1,<$lt,$1-,>~1<;,>~2<;>;$def,-1,t;$def,~2,f;;>;
$def,|,<$~1,$def,~1,t;,$def,f,~2;;>;
$def,?,
 <$$lt,~1,~2;,
  $def,t,<$$-,>~2<,>~1<;,
   $def,$-,>~2<,>~1<;,f;,
   $def,>~3<,t;;>;,
  $def,f,<$$-,>~1<,>~2<;,
   $def,$-,>~1<,>~2<;,f;,
   $def,>~3<,t;;>;;>;

q4はすべての列に置けたので出力するから

$def,q4,<~1,~2,~3,~4;>;

第3列に置いてみるq3は

$def,q3,<$z,0,
 $def,z,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $|,$?,>>~1<<,>~1<,3;,
  $|,$?,>>~2<<,>~1<,0;,
  $|,$?,>>~2<<,>~1<,2;,
  $|,$?,>>~3<<,>~1<,0;,
  $?,>>~3<<,>~1<,1;;;;;;,
  $def,f,<$q4,>>>~1<<<,>>>~2<<<,>>>~3<<<,>>~1<<,>>>~4<<<;
   $z,$1+,>>~1<<;;>;,
  $def,t,<$z,$1+,>>~1<<;;>;;>;,
 $def,>~4<,;;>;;>;

q2, q1, q0も同様で

$def,q2,<$y,0,
 $def,y,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $|,$?,>>~1<<,>~1<,2;,
  $|,$?,>>~2<<,>~1<,0;,
  $?,>>~2<<,>~1<,1;;;;,
  $def,f,<$q3,>>>~1<<<,>>>~2<<<,>>~1<<,>>>~3<<<;
   $y,$1+,>>~1<<;;>;,
  $def,t,<$y,$1+,>>~1<<;;>;;>;,
 $def,>~3<,;;>;;>;
$def,q1,<$x,0,
 $def,x,<$~1,
 $def,~1,<$
  $|,$?,>>~1<<,>~1<,0;,
  $?,>>~1<<,>~1<,1;;,
  $def,f,<$q2,>>>~1<<<,>>~1<<,>>>~2<<<;
   $x,$1+,>>~1<<;;>;,
  $def,t,<$x,$1+,>>~1<<;;>;;>;,
 $def,>~2<,;;>;;>;
$def,q0,<$w,0,
 $def,w,<$~1,
 $def,~1,<$q1,>~1<,>>~1<<;
  $w,$1+,>~1<;;>;,
 $def,>~1<,;;>;;>;

と準備出来たから実行してみる.

$q0,4; => 1,3,0,2;2,0,3,1;

4クィーンには双対のこの解しかない.

同様に引数渡しをするのでも, やはりSchemeのようにさっさっさとはいかない. Scheme版はこうだ.

(define (q0 n) (do ((s 0 (+ s 1))) ((= s n)) (q1 s n)))
(define (q1 s n) (do ((t 0 (+ t 1))) ((= t n))
 (cond ((? s t 0)) ((? s t 1))
       (else (q2 s t n)))))
(define (q2 s t n) (do ((u 0 (+ u 1))) ((= u n))
 (cond ((? s u 0)) ((? s u 2)) ((? t u 0)) ((? t u 1))
       (else (q3 s t u n)))))
(define (q3 s t u n) (do ((v 0 (+ v 1))) ((= v n))
 (cond ((? s v 0)) ((? s v 3)) ((? t v 0)) ((? t v 2))
       ((? u v 0)) ((? u v 1))
       ((= n 4) (display (list s t u v)))
       (else (q4 s t u v n)))))
(q0 4) ;=> (1 3 0 2)(2 0 3 1)

Christopher StracheyのGPM

cal

calというのはある年(ある月)のカレンダーを出力してくれるものである.

cal 3 2015

と入力すると

     March 2015
Su Mo Tu We Th Fr Sa
 1  2  3  4  5  6  7
 8  9 10 11 12 13 14
15 16 17 18 19 20 21
22 23 24 25 26 27 28
29 30 31

が出力される. これは文字ベースだが, pcalはPostScriptで出力が得られるものである. 私は自分で書いたpcalも持っている.

2007年の夏のプログラミング・シンポジウムで私は「いろいろなプログラミング言語によるcalのプログラミング」という題でMMIX, Haskell, PostScript, Scheme, Teco, Texでcalを書いた.

GPMを使っていみていると, GPMでもcalを書いてみたくなるのは人情である. で早速やってみた.

まずはSchemeでロジックを確認しよう. ある月のカレンダーを次のように出力するとして, パラメータa, b, cを次のものとする.

(define (pcal a b c)  ;0<=a,b<7, 3<=c<6
(define (ss) (display "   "))  ;空白3文字出力
(define (dd x y) (display x) (display y) (display " "));xy空白
(define (nn) (newline)) ;改行
(define (r n x y)  ;月末処理 最後の行 xyからn回出力
 (if (> n 0) (begin (dd x y)
  (if (= y 9) (r (- n 1) (+ x 1) 0) (r (- n 1) x (+ y 1))))))
(define (q m n x y)  ;m行目n曜日にxyを出力
 (if (= m 0) (r (- 7 b) x y) ;月末処理へ
  (begin (dd x y)
   (cond 
    ((and (= n 0) (= y 9)) (nn) (q (- m 1) 6 (+ x 1) 0))
    ((and (= n 0) (< y 9)) (nn) (q (- m 1) 6 x (+ y 1)))
    ((and (> n 0) (= y 9)) (q m (- n 1) (+ x 1) 0))
    ((and (> n 0) (< y 9)) (q m (- n 1) x (+ y 1)))))))
(define (p n)     ;月初処理 始めの空白日を出力
 (if (= n 0) (q c (- 6 a) 0 1)
  (begin (ss) (p (- n 1)))))
(p a)
)
(newline)
(pcal 3 2 4)@

これで上手くいったのでgpmへ書き換える. マクロ中の空白や改行に注意.

$def,pcal,<
$def,1+,<$~1,
 $def,~1,<$1,2,3,4,5,6,7,8,9,10,$def,1,<~>>~1<;;>;,
 $def, ,1;;>;
$def,1-,<$-1,0,1,2,3,4,5,6,7,8,$def,-1,<~>~1;;>;
$def,-,<$~2,$def,~2,<$-,$1-,>~1<;,$1-,>~2<;;>;,$def,0,~1;;>;
$def,nn,
;
$def,ss,   ;
$def,dd,<~1~2 >;
$def,r,<$~1,
 $def,~1,<$dd,>~2<,>~3<;$>~3<,
  $def,>~3<,<$r,$1-,>>~1<<;,>>~2<<,$1+,>>~3<<;;>;,
  $def,9,<$r,$1-,>>~1<<;,$1+,>>~2<<;,0;>;;>;,
 $def,0,;;>;
$def,q,<$~1,
 $def,~1,<$dd,>~3<,>~4<;$>~2~4<,
  $def,>~2~4<,<$q,>>~1<<,$1-,>>~2<<;,>>~3<<,$1+,>>~4<<;;>;,
  $def,>~2<9,<$q,>>~1<<,$1-,>>~2<<;,$1+,>>~3<<;,0;>;,
  $def,0>~4<,<$nn;$q,$1-,>>~1<<;,6,>>~3<<,$1+,>>~4<<;;>;,
  $def,09,<$nn;$q,$1-,>>~1<<;,6,$1+,>>~3<<;,0;>;;>;,
 $def,0,<$r,$-,7,>>~2<<;,>~3<,>~4<;>;;>;
$def,p,<$~1,
 $def,~1,<$ss;$p,$1-,>~1<;;>;,
 $def,0,<$q,>>~3<<,$-,6,>>~1<<;, ,1;>;;>;
$p,~1;
>;
$pcal,3,2,4;

本来のcal, pcalにするには年月をパラメータa,b,cに変換する必要がある. これには400など我々のGPM世界をはみ出す定数が現れるので, 取りあえずはSchemeで書いてある.

年月からpcalのパラメータを求めるプログラム
(define (ym2pcal y m)
 (let* ((p (lambda (n) (= (modulo y n) 0)))
  (q (lambda (n) (quotient y n)))
  (s `(0 3 ,(if (if (p 100) (p 400) (p 4))
   1 0) 3 2 3 2 3 3 2 3 2 3))
  (d (modulo (- (+ 1 y (q 4) (q -100)
   (q 400)) (apply + (list-tail s m))) 7))
  (z (+ (list-ref s m) 28)))
 (list d (modulo (- 42 (+ d z)) 7) 
  (quotient (- (+ d z) 1) 7))))
(map (lambda (m) (ym2pcal 2015 m)) (a2b 1 13)) =>
((4 0 4) (0 0 3) (0 4 4) (3 2 4) (5 6 5) (1 4 4)
 (3 1 4) (6 5 5) (2 3 4) (4 0 4) (0 5 4) (2 2 4))

$pcal,a,b,cがうまくいったので, 今回はこれで満足しよう.

Christopher StracheyのGPM

12 Days of Christmas

昨年12月12日のブログにクリスマスの歌を書いたのは, GPMのこのマクロを書いた直後であった.

それまでいろいろなプログラム言語で書いてみたので, GPMならどう書けるかと考えるのはまぁ自然だ.

こういう詩のようなものを出力するには, 空白や改行の制御が必要になる. GPMはマクロ評価部分以外は入力をそのまま出力するから簡単かもしれない. 一方, Tarai関数で述べたように, 空白や改行は邪魔なこともあるので, 私のシミュレータは空白改行を無視する/しないの切替え機能を持っている.

またこのマクロは, 本質的なところだけ再現出来ればよいという趣旨で, 元の詩の一部だけを使った.

とはいえ, 難題がある. このGPMの環境では, 通常は0から9までしか数えられないのに, 12日をどう扱うかだ.

とりあえずマクロはこうなっている.

$def,1-,<$-1,0,1,2,3,4,5,6,7,8,9,:,$def,-1,<~>~1;;>;
$def,getn,<$11th,10th,9th,8th,7th,6th,5th,4th,3rd,2nd,1st,
$def,11th,<~>~1;;>;
$def,gets,<$11 Pipers
,10 Lords
,9 Ladies
,8 Maids
,7 Swans
,6 Geese
,5 Rings
,4 Birds
,3 Hens
,2 Turtle Doves
,a Partridge
,$def,11 Pipers
,<~>~1;;>;
$def,song,<$~1,
$def,~1,<On the $getn,>~1<; day
$gets,>~1<;>~2<
$song,$1-,>~1<;,$gets,>~1<;>~2<;>;,
$def,-1,<On the 12th day
12 Drummers
>~2;;>;
$song,:,;

最初のマクロ1-はこれまでの1-とそっくりで, 引数が0なら-1, 1なら0, ... が返る. これは~nを読むとnのアスキーコードから48を引き何番目かを決める. ところでアスキーの表で9の次が:(コロン)なのを利用して:を10として扱うことにした. では;(セミコロン)を11として使えるかというと;はマクロ呼出しの終りを示すからこれは使えない. だが0から9の世界を0から10の世界に拡張できた. それでもまだ12日には問題が残る.

getnは引数が0なら11th, 1なら10th, ..., 10なら1stが返る. 次のgetsは同様で, 0なら11 Pipers改行, 1なら10 Lords改行, ... ,10ならa Partridge改行が返る. カンマが改行の次にあるからだ. 何行か飛ばして最後の行のsongの呼出しを見よう.

$song,:,;とマクロ呼出しになっている. つまり第1引数は:(コロン, 上述のように10), 第2引数は空文字列になっている.

そこでsongの定義をみると, 第1引数のifになっており, -1なら$def,-1,にあるようにOn the 12th day改行12 Drummers改行にして第2引数をつなげる. else部はOn the (getnの返した1st day改行みたいなもの), 続いて$gets, ~1;続いて第2引数. さらにsongを呼ぶようになっている.

という次第で

On the 1st day
a Partridge

On the 2nd day
2 Turtle Doves
a Partridge
...(3rdから11thまで省略)
On the 12th day
12 Drummers
11 Pipers
10 Lords
9 Ladies
8 Maids
7 Swans
6 Geese
5 Rings
4 Birds
3 Hens
2 Turtle Doves
a Partridge

の出力が得られた.

Color RingのRGB

つぎのような虹の両端を繋げた絵が描きたかった. 各色のRGBは円周外に併記してあるようになっている. 赤字がRの値, 緑字がGの値, 青字がBの値である. それぞれの値は0から0xffまでである.



円周外の文字は見難いいので, 変化の様子を図にすると



上の円形の図に右方向の赤が横軸の0で, RGBがff0000, そこから60度の間に緑が00からffへ増える(横軸30の地点). 次は赤が減り, 青が増え, 緑が減り, 赤が増え, 青が減るような変化である.

これは円周360度を36分割してあるが, さらに連続的な絵も描けるわけで, 2度置きに色を変えるとすると

for(i=0; i<180; i++) {
var ang0=-i*Math.PI/90-Math.PI/180;
var ang1=-i*Math.PI/90+Math.PI/180;
context.beginPath();
context.moveTo(r*Math.cos(ang1),r*Math.sin(ang1));
context.lineTo(R*Math.cos(ang1),R*Math.sin(ang1));
context.arc(0,0,R,ang1,ang0,true);
context.lineTo(r*Math.cos(ang0),r*Math.sin(ang0));
context.closePath();
context.fillStyle=cs[i];
context.fill();}

のように扇型のような領域を下にあるcs[i]のRGBで塗り分けることになる.

ここでのマクロはcs[i]の値を生成するものである.

var cs = new Array (
"#ff0000", "#ff0900", "#ff1100", "#ff1a00", "#ff2200", "#ff2b00", 
"#ff3300", "#ff3c00", "#ff4400", "#ff4d00", "#ff5500", "#ff5e00", 
"#ff6600", "#ff6f00", "#ff7700", "#ff8000", "#ff8900", "#ff9100", 
"#ff9a00", "#ffa200", "#ffab00", "#ffb300", "#ffbc00", "#ffc400", 
...
"#ff0033", "#ff002b", "#ff0022", "#ff001a", "#ff0011", "#ff0009",
0);

60度の間に0から255まで変化する. 2度ずつだと255を30で割るから1回の増減量は8.5に相当する. 緑の増え方をみると, 最初が0, 次が9(8.5を四捨五入した), 次が 十六進で11つまり17(8.5*2), ... となっていることが分る.

しかしこの計算はせず, この昇順と降順の値をマクロで定義した.

$def,00^,09;$def,09^,11;$def,11^,1a;$def,1a^,22;$def,22^,2b;
$def,2b^,33;$def,33^,3c;$def,3c^,44;$def,44^,4d;$def,4d^,55;
$def,55^,5e;$def,5e^,66;$def,66^,6f;$def,6f^,77;$def,77^,80;
$def,80^,89;$def,89^,91;$def,91^,9a;$def,9a^,a2;$def,a2^,ab;
$def,ab^,b3;$def,b3^,bc;$def,bc^,c4;$def,c4^,cd;$def,cd^,d5;
$def,d5^,de;$def,de^,e6;$def,e6^,ef;$def,ef^,f7;$def,f7^,ff;
$def,09_,00;$def,11_,09;$def,1a_,11;$def,22_,1a;$def,2b_,22;
$def,33_,2b;$def,3c_,33;$def,44_,3c;$def,4d_,44;$def,55_,4d;
$def,5e_,55;$def,66_,5e;$def,6f_,66;$def,77_,6f;$def,80_,77;
$def,89_,80;$def,91_,89;$def,9a_,91;$def,a2_,9a;$def,ab_,a2;
$def,b3_,ab;$def,bc_,b3;$def,c4_,bc;$def,cd_,c4;$def,d5_,cd;
$def,de_,d5;$def,e6_,de;$def,ef_,e6;$def,f7_,ef;$def,ff_,f7;

Hilbert曲線の時と同様, ^は上向き, _は下向きとし, $def,00^,09;は上向きで00の次は09という定義である.

$def,next,<$~1^;>;
$def,last,<$~1_;>;

と定義すると

$next,00; => 09
$next,$next,00;; => 11

のようになる. 次にfとbを定義する.

$def,f,<$~2, 
 $def,~2,<"#>~1~2~3<",$f,>~1<,$next,>~2<;,>~3<;>;,
 $def,ff,;;>; 
$def,b,<$~2, 
 $def,~2,<"#>~1~2~3<",$b,>~1<,$last,>~2<;,>~3<;>;,
 $def,00,;;>; 

そして

$f,ff,00,00;

と呼ぶと, 第1引数はff, 第2引数は00, 第3引数も00である. fの定義は第2引数=ffなら何もしない; そうでないなら"#の次に3つの引数をつなげ",を出力しfを続けて呼ぶ. 但し第2引数をnextにする となっている. 従って

"#ff0000","#ff0900","#ff1100",...

が得られる. 続いてbを$b,,ff,ff00;と呼ぶと, 第1引数は空文字列, 第2引数はff, 第3引数はff00だから, RGBのRの値を次々と減らした列が得られるのである.

こうして出来た配列で描いたColor Ringがこれだ.

Christopher StracheyのGPM

Ackermann関数

再帰呼出しというとすぐに出てくるのがAckermann関数である.

(define (a x y)
 (cond ((= x 0) (+ y 1))
       ((= y 0) (a (- x 1) 1))
       (else (a (- x 1)
                (a x (- y 1))))))

SICPの定義は少し違う. (演習問題1.10)

(define (a x y)
 (cond ((= y 0) 0)
       ((= x 0) (* 2 y))
       ((= y 1) 2)
       (else (a (- x 1)
                (a x (- y 1))))))

SICPの著者のSussman君はもちろんこの方が正しいというが, ここでは巷間に伝わる前の定義に従う.

$def,a,<$~1,
 $def,~1,<$>~2<,
  $def,>~2<,<$a,$1-,>>~1<<;,
   $a,>>~1<<,$1-,>>~2<<;;;>;,
  $def,0,<$a,$1-,>>~1<<;,1;>;;>;,
 $def,0,<$1+,>~2<;>;;>;
$a,0,0;,$a,0,1;,$a,0,2;,$a,0,3;, => 1,2,3,4,
$a,1,0;,$a,1,1;,$a,1,2;,$a,1,3;, => 2,3,4,5,
$a,2,0;,$a,2,1;,$a,2,2;,$a,2,3;, => 3,5,7,9,
$a,3,0; => 5

1桁の世界ではこの辺までしか計算できないから, あっという間に終るのは有難い. 特にコメントすることもあるまい.

Catalan三角形

TAOCPの式7.2.1.6-(22)にCatalan数とかCatalan三角形というのがある. このブログに「入れ子のかっこ」という話を書いたが, 4組の(,)の並べ方が14通りあり, それがCatalan数Cを使いC(4)=14と表現出来るという話題だ. 三角形の方は



のような形で, Catalan数C_nは図のC_nnである.

C₀₀=1,
C_p,q=C_p(q-1)+C_(p-1)q 0≤p≤q≠0の時
      =0 p<0 または p>qの時

だからSchemeでは

(define (c p q)
 (cond ((and (= p 0) (= q 0)) 1)
       ((or (< p 0) (> p q)) 0)
       (else (+ (c p (- q 1)) (c (- p 1) q)))))

GPMでは

$def,c,<$~1~2,
 $def,~1~2,<$$|,$lt,>~1<,0;,$lt,>~2<,>~1<;;,
  $def,t,0;,
  $def,f,<$+,$c,>>~1<<,$1-,>>~2<<;;,$c,$1-,>>~1<<;,>>~2<<;;>;;>;,
 $def,00,1;;>;
$c,0,0;,$c,1,1;,$c,2,2;, => 1,1,2,
$c,0,3;,$c,1,3;,$c,2,3;,$c,3,3;, => 1,3,5,5,
$c,0,4;,$c,1,4;,$c,2,4; => 1,4,9

と書ける.

論理関数

andやorはどうなるだろうか. 四則演算も自分で定義したくらいだから, 論理演算も出来るであろう. and, or, notはSchemeで書くと

(define (and x y)
 (if x y #f))
(define (or x y)
  (if x #t y))
(define (not x)
 (if x #f #t))

つまり(and x y)はxが真なら結果はyの真偽による; xが偽ならもちろん偽という定義でよい. (or x y)はxが真なら即真, 偽ならyに依存する. (not x)も見ての通り. これをGPMのif then elseで実装する. 真偽値はltと時と同様, tとfとする.

$def,&,<$~1,$def,~1,f;,$def,t,~2;;>;
$def,|,<$~1,$def,~1,t;,$def,f,~2;;>;
$def,\,<$~1,$def,f,t;,$def,t,f;;>;

マクロ名には大体の文字が使えるから, andは&, orは|, notは\を使った.

$&,f,f;,$&,f,t;,$&,t,f;,$&,t,t; => f,f,f,t
$|,f,f;,$|,f,t;,$|,t,f;,$|,t,t; => f,t,t,t
$\,f;,$\,t; => t,f

となる. これを使って多数決maj(majority)と排他的論理和xorを定義する.

$def,maj,<$|,$|,$&,~1,~2;,
  $&,~2,~3;;,$&,~3,~1;;>;
$def,xor,<$|,$&,~1,$\,~2;;,
  $&,$\,~1;,~2;;>;
$maj,f,f,f;,$maj,f,f,t;, => f,f,
$maj,f,t,t;,$maj,t,t,t; => t,t
$xor,f,f;,$xor,f,t;,$xor,t,f;,$xor,t,t; =>f,t,t,f

という次第だ. 二進の加算器が得られた気分だ.

Hilbert曲線

GPMはもともとプログラムの前処理系だったから, これを使ってプログラムの一部を発生させてみたい.

PostScriptでHilbert曲線を描いてみよう. もちろんPostScriptには再帰呼出しの機能があるから, PostScriptだけで簡潔にプログラムできるわけだが, GPMを 使うのも一興である.

まずはHilbert曲線の描き方の復習から.



左下のpは左から進んで来て, +が示すように左折する(+は反時計方向に曲り, - は時計方向に曲る), 左中央のfを左回転したf+分だけ進み, -で右折, fと進み, -で右折, 右回転したf-と進み +で左折して右へ抜ける.

左上のqの描き方も同様に出来ている.

これらp, qから中央のp'を描くのも図の通りで, +で左折, 左回転したq+, 左回転したf+, 右折, p, f, pと進み, 右折, f-, q-と進んで左折する.

q'も同様.

次に大きいp'', q''は今のp, qをp', q' に変更するだけである.

これだけ分ればSchemeで実装できる.

(define (^ x)
 (modulo (+ x 1) 4))
(define (_ x)
 (modulo (+ x 3) 4))
(define (f d)
 (display (list-ref '(
 "l 0 rlineto "
 "0 l rlineto "
 "l neg 0 rlineto " 
 "0 l neg rlineto ") d)))
(define (p n d)
 (if (> n 0)
  (begin
   (q (- n 1) (^ d)) (f (^ d))
   (p (- n 1) d) (f d)
   (p (- n 1) d) (f (_ d))
   (q (- n 1) (_ d)))))
(define (q n d)
 (if (> n 0)
  (begin
   (p (- n 1) (_ d)) (f (_ d))
   (q (- n 1) d) (f d)
   (q (- n 1) d) (f (^ d))
   (p (- n 1) (^ d)))))

関数 ^ は4を法として1を足す, _ は4を法として1を引く.

(f d)はd向きのfを引くPostScriptの命令を返す. つまりd=0なら l 0 rlineto (x 方向へl ,y 方向へ0だけ移動,) d=1なら 0 l rlineto(x 方向へ0, y 方向へl だけ移動)のようになっている. negはその前の値の符号を変える.

(p n d)は大きさnのpを描く. q+, f+ ...だったから(q (- n 1) (^ d)), 1小さいqを(^ d)向きに描き, (f (^ d)), fを(^ d)向きに描き, ...と定義する.

(q n d)も同じだ.

これをGPMにしたのが次だ.

$def,1-,<$-1,0,1,2,3,4,5,6,7,8,
  $def,-1,<~>~1;;>;
$def,^,<$1,2,3,0,$def,1,<~>~1;;>;
$def,_,<$3,0,1,2,$def,3,<~>~1;;>;
$def,f,<$~1,
 $def,0,<l 0 rlineto >;,
 $def,1,<0 l rlineto >;,
 $def,2,<l neg 0 rlineto >;,
 $def,3,<0 l neg rlineto >;;>;
$def,p,<$~1,
 $def,~1,
 <$q,$1-,>~1<;,$^,>~2<;;$f,$^,>~2<;;
  $p,$1-,>~1<;,>~2<;$f,>~2<;
  $p,$1-,>~1<;,>~2<;$f,$_,>~2<;;
  $q,$1-,>~1<;,$_,>~2<;;>;,
 $def,0,;;>;
$def,q,<$~1,
 $def,~1,
 <$p,$1-,>~1<;,$_,>~2<;;$f,$_,>~2<;;
  $q,$1-,>~1<;,>~2<;$f,>~2<;
  $q,$1-,>~1<;,>~2<;$f,$^,>~2<;;
  $p,$1-,>~1<;,$^,>~2<;;>;,
 $def,0,;;>;
/l 20 def 100 100 moveto 
$p,3,0;
stroke

大部分はマクロの定義で, 最後の方 /l 20 def 100 100 moveto はこのまま出力にコピーされる. これはPostScriptのプログラムで, 変数lの値を20に設定する; 座標100 100 に移動する; という指令だ.

次の$p,3,0;でサイズ3, 進行方向0のHilbert曲線を描く命令

0 l rlineto l 0 rlineto 
0 l neg rlineto l 0 rlineto 
l 0 rlineto 0 l rlineto 
(この後同様な28行省略)
0 l neg rlineto 

が出力され, 最後に strokeの命令がコピーされる.

出来上がった図は



上に2つ並ぶ凹のような形に足のついたものの辺の数は15で, それが全部で4個あり, 左と上と右のそれらを繋ぐ辺が3こあるから, この図全体の辺は63個.

上の出力は28行の省略があるから全体で32行. 最後の行以外はrlinetoが2個ずつあるからrlineto, つまり辺の数は63個あるわけだ.

GPMの例題はまだ続く.

Christopher StracheyのGPM

GPMの続きだ.

二進化

例えば3を11, 6を110, 9を1001へのように十進数dを二進数bに変換したいとする.

d % 2の左に⌊d/2⌋の二進化したもを置けばよいが, 除算も剰余もなければ2を繰り返し引くしかない. とりあえずSchemeで書くと

(define (b x y)
 (if (< x 2)
  (if (= y 0) (list x)
   (append (b y 0) (list x)))
  (b (- x 2) (+ y 1))))

というわけで, GPMにすると

$def,b,<$$lt,~1,2;,
 $def,t,<$>~2<,
  $def,>~2<,<$b,>>~2<<,0;>>~1<;,
  $def,0,>~1<;;>;,
 $def,f,
  <$b,$1-,$1-,>~1<;;,$1+,>~2<;;>;;>;
$b,0,0;,$b,1,0;,$b,2,0;,$b,3,0;,$b,4,0;, => 0,1,10,11,100,
$b,5,0;,$b,6,0;,$b,7,0;,$b,8,0;,$b,9,0; 
=> 101,110,111,1000,1001

二項係数

Pascal三角形を思うえば, C_n,mは両端にある時, つまりm=0かm=nの時は1, それ以外は一段上の左(C_n-1,m)と右(C_n-1,m-1)の和 にすればよい.

$def,b,<$~2,
 $def,~2,<$+,$b,$1-,>~1<;,>~2<;,
  $b,$1-,>~1<;,$1-,>~2<;;;>;,
 $def,0,1;,$def,~1,1;;>;
$def,binom,<$bb,0,
 $def,bb,<$~1,
  $def,~1,<$b,>>~1<<,>~1<;,
  $bb,$1+,>~1<;;>;,
  $def,>~1<,1;;>;;>;
$b,4,0;,$b,4,1;,$b,4,2;,$b,4,3;,$b,4,4; => 1,4,6,4,1
$binom,3; => 1,3,3,1

上のbが二項係数で, $~2でmの値を見る. 下の方$def,0,1;はm=0の時, $def,~1,1;はm=nの時の値を返す. $def,~2, がその他の場合を計算する.

binomはPascal三角形のn段目を計算するもので, bbでmを0からnまで回している.

素数テスト

基本演算で定義した剰余を利用する. nの素数性はxを2から順に増やしながらnをxで割り剰余が0なら偽, x=nになったら真とする.

(define (isprime? n)
 (define (p x)
  (cond ((= x n) #t)
        ((= (modulo n x) 0) #f)
        (else (p (1+ x)))))
 (p 2))

従って, isprime?をp?と書くと

$def,p?,<$p,2,
 $def,p,<$~1,
  $def,~1,<$$r,>>~1<<,>~1<;,
   $def,$r,>>~1<<,>~1<;,
    <$p,$1+,>>~1<<;;>;,
   $def,0,f;;>;,
  $def,>~1<,t;;>;;>;
$p?,2;,$p?,3;,$p?,4;,$p?,5;, => t,t,f,t,
$p?,6;,$p?,7;,$p?,8;,$p?,9; => f,t,f,f

p?の定義はまず$p,2,と(p 2)を実行し, すぐにpの定義が続く. $def,p,<$~1, の~1はSchemeのプログラムのxである. その次の行の$def,~1,はelseの部分. 一番下の 行の$def,$gt;~1<<,の~1はn, すなわちx=nならtという定義がこの行だ.

else部分に戻ると$$r,>>~1<<,>~1<,;,とあるが, ここがnをxで割った剰余を計算するところで, >>~1<<がn, >~1<がxである. その剰余でマクロ呼出しし, 下の方の$def,0,f;が割り切れた場合は偽と定義する. elseの定義は$def,の後でもう一度剰余を計算する. やることは$p,$1+,x;である.

tarai関数

竹内郁雄君の発案したtarai関数はGPMでやってみるには都合がよい. tarai関数の定義は

(define (tarai x y z)
  (if (<= x y) y
  (tarai (tarai (- x 1) y z)
         (tarai (- y 1) z x)
         (tarai (- z 1) x y))))

で, (trai 4 2 0) とかやってみると, 盥まわしの様子が分かる. しかしz=0なので早速-1が現れて問題となる. $1-,0;は実行出来て-1になる. 基本関数のltの 引数の下が-1まで使えるようになっているのは, ここで使いたかったからである.

次は(<= x y). 基本関数にあったのはleではなく, ltであったが, もちろん(< y x)の形で使い, then部分とelse部分を交換して書いておく.

従ってtarai関数は

$def,tarai,<$$lt,~2,~1;,
 $def,f,~2;,
 $def,t,<$tarai,
  $tarai,$1-,>~1<;,>~2<,>~3<;,
  $tarai,$1-,>~2<;,>~3<,>~1<;,
  $tarai,$1-,>~3<;,>~1<,>~2<;;>;;>;
$tarai,4,3,2; => 4
$tarai,4,2,0; => 4

この辺でGPMの空白改行問題を説明しなければならない. StracheyのGPMの論文には, マクロ呼出しは評価の文字列に置き換わるがそれ以外は入力がそのまま出力されると書いてある. アセンブリ言語の前処理用としてはその通りであるが, tarai関数のマクロ定義をこのように整形しておくと実はうまく走らないのである.

(tarai 4 3 2)の実行され方を見ると, (<= 4 3) は #fなので(tarai (- 4 1) 3 2), (tarai (- 3 1) 2 4), (tarai (- 2 1) 4 3) つまり(tarai 3 3 2), (tarai 2 2 4), (tarai 1 4 3)をまず計算する. この3個はどれも(<= x y)なので, それぞれ3, 2, 4であり, 次に(tarai 3 2 4)を計算しなければならない.

これも(<= 3 2)ではないので, (tarai 2 2 4), (tarai 1 4 3), (tarai 3 3 2)を計算し, これらは直接終わるので(tarai 2 4 3)の計算に移り, (<= 2 4)だから4となるわけだ.

問題は

$tarai,
 3,
 2,
 4;

になった時に改行や空白が邪魔になることである. このtaraiの第1引数は`改行空白3', 第2引数は`改行空白2', 第3引数は`改行空白4'であり, これらが$1-に渡されてしまう.

そういう次第で, GPMの処理系では改行や空白は無視するようにしてあるが, この後で出て来る例題では改行や空白をそのまま使いたいものもあって, その辺は どう対処するのがよいか疑問である.

BCPLを設計したMartin RichardsはBGPMというGPM処理系を使っているそうだが, そのBGPMではバッククォート(`)をエスケープに使い, バッククォートから後その行の最後までと次の行から空白を無視する仕様になっているとそうだ.

Christopher StracheyのGPM

前回はHanoiの塔まで説明した. また続きのマクロを示す.

Fibonacci数

GPMで遊ぶのに適している例題の一つがFibonacci数である.

(define (fib n)
 (cond ((= n 0) 0)
       ((= n 1) 1)
       (else (+
        (fib (- n 1))
        (fib (- n 2))))))

とりあえずGPM風にすると

$def,fib,<$n,
 $def,n,<$+,
  $fib,$1-,n;;,
  $fib,$1-,$1-,n;;;;>;
 $def,1,1;,
 $def,0,0;;>;

+のマクロは基本演算で定義した.

nはもちろん~1にする. <,>が2重に使われているが, 内側のクォートの内部では ~n は>~n< にする.

従って

$def,fib,<$~1,
 $def,~1,<$+,
  $fib,$1-,>~1<;;,
  $fib,$1-,$1-,>~1<;;;;>;
 $def,1,1;,
 $def,0,0;;>;

やってみると

$fib,0; => 0
$fib,1; => 1
$fib,2; => 1
$fib,6; => 8

階乗

次は階乗. マクロ名に!が使えて嬉しい. *は基本演算参照

$def,!,<$~1,
 $def,~1,<$*,>~1<,$!,$1-,>~1<;;;>;,
 $def,0,1;;>;

と簡単だ. 実行例は

$!,0; => 1
$!,1; => 1
$!,2; => 2
$!,3; => 6

中央値

英語ではmedian. TAOCPの7.1.1に登場する. 奇数個の値をソートしてa₀,a₁,...,a_2nが得られた時のa_nを値とする.

<1,0,4,2,3>=2だ. 奇数個の値がfalseとtrueだけとし, false<trueとした時, 中央値は多数決になる. <false,false,true>=false,<true,false,true>=true. 中央値は多数決を一般化したものである.

ここでは3個の値の中央値を見つける.

(define (med a b c)
 (if (< b a)
  (if (< c a)
   (if (< c b) b c)
   a)
  (if (< c b)
   (if (< c a) a c)
   b)))

このGPM版は

$def,med,<$$lt,~2,~1;,
  $def,t,$$lt,~3,~1;,$def,t,$$lt,~3,~2;,$def,t,~3~2~1;,
                                        $def,f,~2~3~1;;;,
                     $def,f,~2~1~3;;;,
  $def,f,$$lt,~3,~2;,$def,t,$$lt,~3,~1;,$def,t,~3~1~2;,
                                        $def,f,~1~3~2;;;,
                     $def,f,~1~2~3;;;;>;

実行すると

$med,0,0,0;,$med,0,0,1;,$med,0,0,2;,$med,0,1,0;,$med,0,1,1;,
$med,0,1,2;,$med,0,2,0;,$med,0,2,1;,$med,0,2,2;,$med,1,0,0;,
$med,1,0,1;,$med,1,0,2;,$med,1,1,0;,$med,1,1,1;,$med,1,1,2;,
$med,1,2,0;,$med,1,2,1;,$med,1,2,2;,$med,2,0,0;,$med,2,0,1;,
$med,2,0,2;,$med,2,1,0;,$med,2,1,1;,$med,2,1,2;,$med,2,2,0;,
$med,2,2,1;,$med,2,2,2;
=>
0,0,0,
0,1,1,
0,1,2,
0,1,1,
1,1,1,
1,1,2,
0,1,2,
1,1,2,
2,2,2

GCD

Euclidの互除法が有名だが, 9までの数を扱うこのGPMの世界では引き算で計算できる.

(define (gcd a b)
 (cond ((= a b) a)
       ((< a b)
        (gcd a (- b a)))
       ((> a b)
        (gcd (- a b) b))))

GPMに書き直す.

$def,gcd,<$~2,
 $def,~2,
  <$$lt,>~1<,>~2<;,
  $def,f,
   <$gcd,$-,>>~1<<,>>~2<<;,>>~2<<;>;,
  $def,t,
   <$gcd,>>~1<<,$-,>>~2<<,>>~1<<;;>;;>;,
 $def,~1,~1;;>;
$gcd,2,4;,$gcd,5,3;,$gcd,6,3; => 2,1,3

この辺までは簡単の単だ.

Christopher StracheyのGPM

このブログでGPMのことを書いたのは2013年12月だから1年以上前になる. 英国の計算機保存団体の発行するComputer Resurrectionの昨年の夏号にStrachey's General Purpose Macrogeneratorという記事を見付けたのを切っ掛けに元の論文にあった例題以外のマクロを書こうと思いたった.

かなりたくさんのマクロを書いたので, GPMの楽しさを紹介しようとして今年のプログラミング・シンポジウムでそれに関する話をした.

これとそれに続く何回かのブログでは, それらのマクロについて書きたい.

まず簡単におさらいをしておく.

"$def,a,<b~1d>;" はマクロ "a" が "<b~1d>" であると定義する. "$a,c;" でマクロ "a" を実引数 "c" をもって呼び出すと, マクロ本体の第1引数 "~1" に "c" が代入されて "bcd" が返る. "~0" は第0引数を表わすから, マクロ "a'" を "$def,a',<~0b~1d>;" と定義し "$a',c;" と呼び出すと "a'bcd" が返る.

マクロ呼出しは "$マクロ名, 実引数1, 実引数2, ... ;" の形で, マクロ名も実引数もまず評価される, つまりマクロ呼出しがあれば実行し, 引数"~n" があれば置き換える. それ以外はそのまま. 評価を避けたい時は"<" と ">" で囲むが評価が済むと両端の "<" と ">" がなくなる.

上の "a" の定義があった時, "$a,$a,c;;" と呼び出すと, 第1引数 "$a,c;" がまず評価されて "bcd" になり, それで "$a,bcd;" と呼び出すから "bbcdd" が返る.

マクロ呼出しの実引数の並びの中に局所定義を書くことが出来る. 定義されてから呼び出すから, "$a,c,$def,a,<b~1d>;;" のように書くと, "bcd" が返る. 局所定義は呼出しが終わると消える.

同じマクロ名の定義はスタック状に記憶され, 最新のものを使う. 定義が消えるともとの定義が見えるようになる.

"$def,a,b;" と定義しておき, "$a,$def,a,c;,$def,a,d;;" と呼び出すと, "a" の最後の定義が "$def,a,d;" だから "d" が返り, それが済むと最初の定義がスタックの上に来るから, ここで "$a;" と呼び出すと "b" が返る.

この機能を使うと条件式が書ける.

"(if (eq? α β) γ δ)" は"$α,$def,α,δ;,$def,β,γ;;" と書く. αとβが同じ時は, 2つの局所定義の後のもαになるからそちらを使い, γになり, 違う時は, 前の局所定義を使い, δになる.

これだけ知っていれば, GPMのマクロを書くことが出来る.

基本演算

GPMには算術演算もないから, その辺から始めなければならない. 最初は引数に1を足すマクロ "1+". 定義と使用例は次のとおり.

$def,1+,<$1,2,3,4,5,6,7,8,9,10,$def,1,<~>~1;;>;
$1+,0; => 1
$1+,4; => 5
$1+,9; => 10

"$1+,4;" の場合, マクロ "1+" の本体 "$1,2,3,4,5,6,7,8,9,10,$def,1,<~>~1;;" が評価される. つまりマクロ "1" を実引数 "2,3,4,5,6,7,8,9,10" で呼び出す. その"1"の局所定義は後にあり, "~1" に "4" が代入されて "$def,1,~4;" になっている. 従って第4引数 "5" が返る.

$def,1-,<$-1,0,1,2,3,4,5,6,7,8,$def,-1,<~>~1;;>;
$1-,0; => -1
$1-,9; => 8

"1-"も上のマクロ "1+" と殆ど同じ. 引数が"~"の後の1文字なので, ここで使う整数は0から9までということになる.

$def,+,<$~1,
 $def,~1,<$1+,$+,$1-,>~1<;,>~2<;;>;,
 $def,0,~2;;>;
$+,0,3; => 3
$+,3,5; => 8

マクロ "+" は条件式になっている. 最後の行 "def,0,~2;" は, 第1引数が "0" なら第2引数が答, そうでないなら, 第1引数から1を引いたものと第2引数と足してそれに1を足すと再帰的に定義する.

Scheme流に書けば
(λ (x y) (if (= x 0) y (1+ (+ (1- x) y))))

$def,-,<$~2,
 $def,~2,<$-,$1-,>~1<;,$1-,>~2<;;>;,
 $def,0,~1;;>;
$-,3,0; => 3
$-,6,4; => 2

第2引数による条件式で, 0なら第1引数が答. そうでないなら第1引数から1を引いたものから第2引数から1を引くと再帰的に定義する.

(λ (x y) (if (= y 0) x (- (1- x) (1- y))))

$def,*,<$~1,
  $def,~1,<$+,$*,$1-,>~1<;,>~2<;,>~2<;>;
  $def,0,0;;>;
$*,0,5; => 0
$*,1,4; => 4
$*,2,3; => 6

(λ (x y) (if (= x 0) 0 (+ (* (1- x) y) y)))

$def,lt,<$~1,
  $def,~1,<$p,>~1<,>~2<,$def,p,$lt,$1-,>~1<;,>~2<;;;>;
  $def,-1,t;$def,~2,f;;>;
$lt,-1,-1; => f
$lt,-1,0;  => t
$lt,0,-1;  => f

ltつまり<は, この世界の下が-1までであることを利用している.

(λ(x y) (cond ((= x y) f) ((= x -1) t) (else (lt (1- x) y))))

これを使って剰余を書く.

$def,r,<$$lt,~1,~2;,
 $def,t,~1;,$def,f,<$r,$-,>~1<,>~2<;,>~2<;>;;>;
$r,9,5; => 4

(λ (x y) (if (< x y) x (r (- x y) y)))

基本演算ばかりでは面白くないので, 応用として情報科学標準問題のHanoiの塔をやってみよう.

Hanoiの塔

$def,1-,<$-1,0,1,2,3,4,5,6,7,8,
 $def,-1,<~>~1;;>;
$def,hanoi,<$~4,
 $def,~4,<$hanoi,>~1<,>~3<,>~2<,$1-,>~4<;;
  +>~1<->~3<+
  $hanoi,>~2<,>~1<,>~3<,$1-,>~4<;;>;
 $def,0,<>~1<->~3<>;;>;
$hanoi,a,b,c,0; => a-c
$hanoi,a,b,c,1; => a-b+a-c+b-c
$hanoi,a,b,c,2; 
=> a-c+a-b+c-b+a-c+b-a+b-c+a-c

$hanoi,a,b,c,n;はn枚の円板をaからcへbを中継点として移動する手続きで, nが0なら$def,0,にあるように ~1-~3とする. -は引き算ではなく, 引数の間に-を書くことである. そうでないなら, $hanoi,~1,~3,~2,$1-,~4;; をやり +~1-~3+とし, $hanoi,~2,~1,~3,$1-,~4;; をやると定義してある.

結果は上のようだ. 次のブログへ続く.

Christopher StracheyのGPM

Christopher Stracheyという名前を初めて見たのは1959年にパリで開催された第1回のIFIPの会議の報告書で, そのpp.336-341に彼の
Time sharing in large, fast computers
という論文があった.

要するに割込みの機能を使ってのマルチプログラミングの提案であるが, 当時我々東大物理の高橋研のパラメトロン計算機でも, すでに割込みと並列計算の実験を始めていたので, 同じようなことは, 洋の東西で同じ頃に気附くものだと思った.

そのStracheyに出逢ったのは, 1971年4月 英国Warwick大学で開かれたIFIP WG2.2の会議でであった. この会議には主査のMike Woodger(NPL)を始め, Edsger Dijkstra, Willem van der Poel, Simulaを開発したOle-Johan Dahlなど有名な計算機科学者が大勢いた. その会議中 パーティーが主催者のJohn Buxtonの超古い家で開催され, みなが車に分乗して行くことになった. その時昔の小さいMiniに乗せてくれたのが大柄なStracheyであった. 「Eiitiは後に入れ」と私を後部座席に押し込み, 助手席に乘ったBrian Randellと機関銃のような英語で話し合っていた.

さて最近のIEEE Annals of the History of Computing(July-September 2013)を眺めていたら, 何年か前に私が情報処理学会誌に「Wilkes先生を悼む」を執筆した時にWilkes先生の写真を 送ってくれたDavid HartleyさんがCPLのことを書いていて, その参考文献を辿っているうちに, CPLのアセンブラをGPM(General Purpose Macrogenerator)で作ったという話から, GPMを開発したStracheyがComputer Journalに寄せた論文
C. Strachey, A general purpose macrogenerator, Computer Journal Vol.8, No.3, 225-241
を探しあてた.

CPLはCambridge Plus Londonとも思えるが, Combined Programming Languageのアクロニムである. この言語はその後Martin RichardsがMITにいるころ, BCPLに単純化して開発し, さらにベル研究所に行ってC言語になった, ということを覚えている人はもう少ないに違いない.

ところでそのmacrogeneratorである.

macroというからにはマクロ定義とマクロ呼出しがあるわけで, aというマクロをb~1dと定義すると, aがマクロ名, b~1dがマクロ本体で, 本体のうちbとdは定数, ~1は第1引数である. 一方, $a,c;がマクロ呼出しで, (もとの論文では先頭は§であるがASCII文字にないので, 以下では$を使う.) マクロ名の本体に対して, cが第1実引数となって, 呼出しの結果はbcdとなる.

マクロ呼出しは $マクロ名,引数1,引数2,...; の形. このマクロ名は引数0としても使うことが出来る.

マクロ呼出しは $ と ; で, 定数は < と > で囲まれているから, マクロ名や引数の中に再帰的に書くことが出来る. その場合, 局所的なマクロ呼出しは呼出しの結果, 局所的な定数は, 一番外の < と > を外した定数本体でその部分を置き換える. 置き換えて出来た結果の文字列で外側のマクロを呼び出す.

GPMではマクロ定義もマクロ呼出しの形で, 上のマクロaの定義は

$def,a,<b~1d>;

のように書く. このマクロ呼出しは空の文字列を結果として返す.

マクロ本体は, この例のように, 本体を評価されたくない時は < と > で囲む.

マクロ呼出しの入れ子の例は次の通り:

引数にマクロ呼出しがある例

$def,a,<b~1d>;

と定義し,

$a,$a,c;;

と呼び出すと,

bbcdd

が返る.

マクロ名にマクロ呼出しがある例

$def,a,<b~1d>;$def,bcd,<b~1c~2d>;

と定義し

$$a,c;,e,f;

と呼び出すと

bdcfd

が返る.

Stracheyの論文にはsucとsuccessorというマクロの例がある.

$def,suc,<$1,2,3,4,5,6,7,8,9,10,$def,1,<~>~1;;>;
$def,successor,
 <$~2,$def,~2,~1<,$suc,>~2<;>;$def,9,<$suc,>~1<;,0>;;>;

sucは$suc,4;のように呼び出す. すると本体の1というマクロを呼び出すが, 引数の評価中にマクロ1が定義される. 引数~1が4なのでこのマクロの本体は~4になり, 1のマクロから5がとられて4の次の5が返る.

successorは 2桁の数の次を返す. $successor,3,4;だと3,5が, $successor,2,9;だと3,0が返るものだ.

3,4の場合はsuccessorの本体が

$4,$def,4,3,$suc,4;;$def,9.$suc,3;,0;;

となりマクロ4を呼び出そうとする. その$に対応する;は一番右にあるので, その前にマクロ4と9を定義する.

$def,4,3,$suc,4;;

だからマクロ4は3,5になり

$def,9,$suc,3;,0:

だからマクロ9は4,0になる. この状態でマクロ4を呼び出すから3,5か返る.

1の桁が9だと, マクロ9が2回定義され, その状態でマクロ9を呼び出すから後で定義した繰り上げのあるマクロの結果が返るのである.

この例にあるように, 本体評価中に定義されたものは, 評価が終わると定義のリストから削除されることに注意しよう.

Stracheyの元の論文にはCPLで書いたGPMの実装が載っている. CPLには再帰呼出しなどないから, スタックの上にリンクをつなげたりしていて, あまり読みたいとも思わない.

以下は私がSchemeで実装したものである. StracheyのGPMには四則演算の機能もあるが, そういうのはGPMの本質的なものではないから, 割愛した.

(define ch '())
(define (gpm str env args)
 (let ((outs "") (index 0))
  (define (getch)
   (set! ch (string-ref str index))
   (set! index (+ index 1))
   (if (or (char=? ch #\space) (char=? ch #\newline)) (getch)))
  (define (readquote)
   (let ((outs ""))
    (define (rq)
      (getch)
      (cond ((char=? ch #\>) outs)
            ((char=? ch #\<)
             (set! outs
              (string-append outs "<" (readquote) ">"))
             (rq))
            (else
             (set! outs (string-append outs (string ch)))
             (rq))))
    (rq)))
  (define (readstring)
   (let ((outs ""))
    (define (rs)
     (if (= index (string-length str)) outs
      (begin (getch)
       (cond ((char=? ch #\,) (cons ch outs))
             ((char=? ch #\;) (cons ch outs))
             ((char=? ch #\<)
              (set! outs (string-append outs (readquote)))
              (rs))
             ((char=? ch #\~)
              (getch)
              (set! outs (string-append outs
               (list-ref args (- (char->integer ch) 48))))
              (rs))
             ((char=? ch #\$)
              (set! outs (string-append outs (readmacrocall)))
              (rs))
             (else
              (set! outs (string-append outs (string ch)))
              (rs))))))
    (rs)))
  (define (readmacrocall)
    (let ((actuals '()))
     (define (rm)
      (let* ((result (readstring))
             (ch (car result)) (s (cdr result)))
       (cond ((char=? ch #\,)
              (set! actuals (cons s actuals)) (rm))
             ((char=? ch #\;)
              (set! actuals (cons s actuals))
              (macrocall (reverse actuals))))))
     (rm)))
  (define (macrocall actuals)
   (cond ((string=? (car actuals) "def")
          (set! env (cons (cdr actuals) env)) "")
         (else
          (let ((def (assoc (car actuals) env)))
           (apply (cons (cadr def) actuals))))))
  (define (apply expr)
   (gpm (car expr) env (cdr expr)))
  (define (gloop)
   (let ((result (readstring)))
    (cond ((string? result) (string-append outs result))
          ((char=? (car result) #\,)
           (set! outs (string-append outs (cdr result) ","))
           (gloop)))))

  (gloop)))

上の例を実行してみよう.

(define str "$def,a,;$a,c;")
(gpm str '() '()) => bcd

(define str "$def,a,;$a,$a,c;;")
(gpm str '() '()) => bbcdd

(define str "$def,a,;$def,bcd,;$$a,c;,e,f;")
(gpm str '() '()) => becfd

(define str "$def,suc,<$1,2,3,4,5,6,7,8,9,10,$def,1,<~>~1;;>;
$suc,4;")
(gpm str '() '()) => 5

(define str "$def,suc,<$1,2,3,4,5,6,7,8,9,10,$def,1,<~>~1;;>;
$def,successor,
 <$~2,$def,~2,~1<,$suc,>~2<;>;$def,9,<$suc,>~1<;,0>;;>;
$successor,3,4;,$successor,2,9;")
(gpm str '() '()) => 3,5,3,0

ついでに, 論文にあったsumは

$sum,α,β,γ;

で2桁の十進数α,βに1桁の数γを足すもので, $3,4,2;は以下のように3,6になる.

(define str "$def,suc,<$1,2,3,4,5,6,7,8,9,10,$def,1,<~>~1;;>;
$def,successor,
 <$~2,$def,~2,~1<,$suc,>~2<;>;$def,9,<$suc,>~1<;,0>;;>;
$def,sum,<$s,~1,~2,0,
 $def,s,<$~3,$def,~3,<$s,>$successor,~1,~2;
  <,>$suc,~3;<;>;$def,>~3<,~1<,>~2;;>;;>;
$sum,3,4,2;")
(gpm str '() '()) => 3,6

これは難しいからマクロ呼出しのトレースをしてみる.

00 (def suc $1,2,3,4,5,6,7,8,9,10,$def,1,<~>~1;;)
01 (def successor $~2,$def,~2,~1<,$suc,>~2<;>;
  $def,9,<$suc,>~1<;,0>;;)
02 (def sum $s,~1,~2,0,$def,s,<$~3,$def,~3,<$s,>
  $successor,~1,~2;<,>$suc,~3;<;>;$def,>~3<,~1<,>~2;;>;;)
03 (sum 3 4 2)
04 (def s $~3,$def,~3,<$s,>$successor,~1,~2;<,>
  $suc,~3;<;>;$def,2,~1<,>~2;;)
05 (s 3 4 0 )
06 (successor 3 4)
07 (def 4 3,$suc,4;)
08 (def 9 $suc,3;,0)
09 (4 )
10 (suc 4)
11 (def 1 ~4)
12 (1 2 3 4 5 6 7 8 9 10 )
13 (suc 0)
14 (def 1 ~0)
15 (1 2 3 4 5 6 7 8 9 10 )
16 (def 0 $s,3,5,1;)
17 (def 2 3,4)
18 (0 )
19 (s 3 5 1)
20 (successor 3 5)
21 (def 5 3,$suc,5;)
22 (def 9 $suc,3;,0)
23 (5 )
24 (suc 5)
25 (def 1 ~5)
26 (1 2 3 4 5 6 7 8 9 10 )
27 (suc 1)
28 (def 1 ~1)
29 (1 2 3 4 5 6 7 8 9 10 )
30 (def 1 $s,3,6,2;)
31 (def 2 3,5)
32 (1 )
33 (s 3 6 2)
34 (successor 3 6)
35 (def 6 3,$suc,6;)
36 (def 9 $suc,3;,0)
37 (6 )
38 (suc 6)
39 (def 1 ~6)
40 (1 2 3 4 5 6 7 8 9 10 )
41 (suc 2)
42 (def 1 ~2)
43 (1 2 3 4 5 6 7 8 9 10 )
44 (def 2 $s,3,7,3;)
45 (def 2 3,6)
46 (2 )

行0,1,2はマクロ定義, 3が呼出しだ. sumを呼び出すと$s,3,4,0とマクロを呼び出す準備をするが ;はまだないので$def,s,...をやってsを定義する.

この際殆どの引数は< >に囲まれているが, 右から15文字目くらいの~3はsumの最後の引数2になる. 4行目で見るとおり. ここでsを呼び出す($s,3,4,0;).

sの本体は$0の呼出しをしようとするが$def,0,があるので0を定義する(16行目). 3,5は$successor,~1,~2;で, 1は$suc,~3;で作られる. それを作るのがトレースの15行目までだ. 次にマクロ2を定義する(17行目).

やっと0が呼び出せ(18行目), Ss,3,5,1;を呼び出す(19行目).

今度はマクロ1と2を同じように定義し, $s,3,6,2;を呼び出す(33行目).

するとマクロ2と2が定義され(44, 45行目), 後から定義された2の本体3,6が返るのである.

万歳. うまくいっているようだ.