livedoor2008年09月04日
ちょっと草植えときますね型言語 GrassをAWKで実装してみるの巻。
Grass は λ-calculus（ラムダ計算）をベースにした「関数型言語」で、「関数定義」「関数適用」のみの組合せでプログラムを表現します。使う文字は W,w,v の３種類。（その他の文字は無視）
今回、こういう言語の実装には正直向いていなさそうなAWKで実装してみました。
AWKの上でYコンビネータが動いているのは自分でもあまり想像したくないのですが・・・grass.elのところにあるサンプルのうち、入力を伴うもの以外はとりあえず全部通るようです。
Grass は λ-calculus（ラムダ計算）をベースにした「関数型言語」で、「関数定義」「関数適用」のみの組合せでプログラムを表現します。使う文字は W,w,v の３種類。（その他の文字は無視）
今回、こういう言語の実装には正直向いていなさそうなAWKで実装してみました。
AWKの上でYコンビネータが動いているのは自分でもあまり想像したくないのですが・・・grass.elのところにあるサンプルのうち、入力を伴うもの以外はとりあえず全部通るようです。
実装方法（概説）
- 言語仕様としては、本家ドキュメントのほか、ここが参考になりました。
- せめて配列がAWKでファーストクラスなオブジェクトだったら楽なんですが...
- 仕方がないので、文字列でなんでも表現しようではないか
- 関数は "/i[j]a.b;c.d;e.f;...;y.z;" のような文字列で表現。iは引数の個数（整数）、jは環境の参照番号（整数）。a.b;（a,bはそれぞれ整数）で、スタックの上からa番目にある関数を同じくb番目の何かを引数として適用（ないし部分適用）。
- ここでaは1以上の整数だが、0をidentity、というか λx.x とし、これを利用してTrue/Falseを実装。
- 引数が２個以上の関数に１引数を与えた場合、部分適用を行い、引数を１つ減らした関数，即ちiを１減らし、環境jにその引数をpushしたものを返す。
- プリミティブ関数は /@in, /@out, /@succ のように /@ で始まる文字列で表現。
- 数値(0-255)はそのまま。（ちなみにAWKでは "5"-3=2,"2"*"3"=6, 5 "7" = "57" のように数値文脈では数値に、文字列文脈では文字列として扱われる）
- 環境は "hoge:hoge:hoge:/@out:/@succ:119:/@in:E:" のような文字列で表現。これを配列に保持し、配列の何番目に保存しているかを参照番号とする。
- 関数では";"、環境では":"とデリミタを使い分けているのは、最初、関数（文字列）の中に環境も入れていた名残り。
- ・・・
【追記】true/false関数の定義の最後に , (カンマ)がないと正しく動かないので修正。(9/10)
サンプル実行結果
grass-sample-w
wWWwwwwサンプルのコメント：「w」を1個出力します。
====== Grass on AWK 0.06 ======
w
grass-sample-w16
wwWWwWWWwvwWWwwWwwwWwwwwwWwwwwwwwwサンプルのコメント：チャーチ数で2^2=4、2^4=16を計算し、「w」を16個出力します。
====== Grass on AWK 0.06 ======
wwwwwwwwwwwwwwww
grass-sample-ascii
wWWwWWWWwvwwWWwWWWwvwwwWWWwwWwwWWWWwvwWWwwwWWWwWWWWWwwWwwwwwWwwwWWWWWWWWwWWWWww wWwwwWWWWWWWWWWwWWWWwwwwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwWWWwwwwwwwwwwwwwwwWwwサンプルのコメント：ASCII印字可能文字をコード順に出力します。
====== Grass on AWK 0.06 ======
!"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~
grass-sample-inputw
wWWWwwwwWWWWWWwWwwwwwwWwwwwwwwWwwwwWWWWWWWwサンプルのコメント：1文字入力し、その文字が「w」なら「w」を出力し、「w」以外ならば「x」を出力します。
====== Grass on AWK 0.06 ======失敗
grass-sample-echo
wwWWwWWWwvwWWwwWwwwwwWwwwwwwwWWwWWWWWWWWWWwWwwWwWwwwwwwwwwwWwwwwWWWwwwwwwwwwwWw wwwwwwwwwwサンプルのコメント：入力された文字をそのまま出力します。C-dまたはbackspaceで終了します。
====== Grass on AWK 0.06 ======失敗
grass-sample-hello
wWwwwWwwwwwWWWWwvwvwwWWWWwWWWWwwwvwwWWwwWwwvwwWWWwWWWwvwWWwWwvwWWwwwwwWwwvwwwWW WwwWwwWWWWwvwvwWWwwwvwwWWwWWWwvwWWWWwwvwWWWWwWwwwwWWWWWwWWWwwWwWWwwwwwWwwwwWWWW WWWwWWWWWWWWwWWWWWWWWWWWwWwwWWwwwwWWWwwwwwwWWWWWWWWWWWWwwwwwwwwWwwWWwwwwWWWwwww wwWWWWWWWWWWWWWWWWWWWWWwWwwwwwwWWwwwwWWWwwwwWWWWwWWWWWWWWWWWWWWWWWWWWWwwwwwWwwW WwWWWwWWWWwWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWWwwwwwwwwWwwwwwwwwWwwwwwWwwwwwwWwww wwwWwwwwwwwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwWwww wwwwwwwWwwwwwwwwwwWwwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwwwwwサンプルのコメント：「Hello, world!」と出力します。コードを短くするために、いろいろ細工をしています。Yコンビネータを使ってみたりｗｗｗｗ。ちなみに長さは551文字です。
====== Grass on AWK 0.06 ======
Hello, world!
grass-sample-factorial
wwWWwwWwwvwwWWWwWWWwvwWWwWwvwvwwWWWwwvwwvwWWWwwWWwWwwwwwvwwwWWwwwWWwvwwwWWWWwwW WWWWWWWwwWWWWWwwWwwWwwwwwwwwwwwwvwwwWWwWWWWwvwwWWwvwwWWWWWwWWWWWWWWwWwwwwwWWwWw wwwwwWwwwwwWWWWWWWWWWwwwwwwwWwwvwwWWwWWWwWWWWwWWWWWwWWWWWWwWWWWWWWwvwWWWWWWWWWW WWwwwWwwwWwwwwwwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwwwwサンプルのコメント：6の階乗、6!=720を再帰的に計算し、「w」を720個出力します。再帰のためにYコンビネータを使っています。
====== Grass on AWK 0.06 ======
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
grass-sample-fibonacci
wwWWwwWwwvwwWWWwWWWwvwWWwWwvwvwwWWWwwvwwvwWWWwwWWwWwwwwwvwwwWWwwwWWwvwwwWWWWwwW WWWWWWWwwWWWWWwwWwwWwwwwwwwwwwwwvwwwWWWwwWwwWWWWwvwwWWwvwwWWWWWwWWWWWWwWWWWWWWW WwWwwwwwwWWwwwwwwwwwwwwWWWwwWWWWwwWWwwwwwwwwwWWwwwwwwwwwwWWwwwwwwwwwWWwwwwwwwww WWwwwwwwwwwwwwwwwWwwvwWWWWwwwWwWwwwwwwWwwWWwWWWWWWWWWWWWWWWWwwwwwwwWwwWwwwwwwww wwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwwwwwwwwサンプルのコメント：フィボナッチ数の12番目、144を再帰的に計算し、「w」を144個出力します。再帰のためにYコンビネータを使っています。
====== Grass on AWK 0.06 ======
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
grass-sample-fibonacci-iterative
wwWWwwWwwvwwWWWwWWWwvwWWwWwvwvwwWWWwwvwwvwWWWwwWWwWwwwwwvwwwWWwwwWWwvwwwWWWWwwW WWWWWWWwwWWWWWwwWwwWwwwwwwwwwwwwvwwwWWWwwWwwWWWWwvwwWWwvwWWWwwWwWWWWWwwWwwwwwwW wwwWWWWWwWwwwwwwwwwwwwwwwwwwwwWWWWWwWwwwwwwwwwwwwwwwwwwwwwwwWWWWWWWWWWwwwwwwwww wwwwwwwwwwwwwWwwwwwwwwwwwwwwwwwwwwwwwwwWWWWWWWWWWWWWWWWWWWWWWWWwwwvwwwwWWWWWwwW WWWwwwwwwwwWwwwwWWWWWWWWWWWwwwwWWWWWWWWWWWWWWwWwWwwwwwwwwwwWwwwwwwwwwWwwwwwwWww wwwwvwWWWWWwwwwWwWwwwwwwwWwwWWwWWWWWWWWWWWWWWWWWwwwwwwwWwwwwwwwwwwwwwwwWwwwwwww wwwwWwwwwサンプルのコメント：フィボナッチ数を先頭から12番目までを順に計算し、「w」を棒グラフのように出力します。ループのためにYコンビネータを使っています。
====== Grass on AWK 0.06 ======
w
w
ww
www
wwwww
wwwwwwww
wwwwwwwwwwwww
wwwwwwwwwwwwwwwwwwwww
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww
grass-sample-infinity
無限に草植えときますねｗＷＷｗｗｗｗＷＷｗｗサンプルのコメント：Grassの公式サンプルです。無限に「w」を出力し続けます。
====== Grass on AWK 0.06 ======
wwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwwww ....wwwwwSegmentation fault
ソースコード(AWK)
#!/usr/bin/env gawk -f
#
# grass.awk - Grass on AWK, ver 0.06
#
# usage: awk -f grass.awk -v srcfile=foobar
#
BEGIN {
# RS = "[vｖ]" ← うまくいかないね
RS = "v"
if (verbose ~ /^$/) verbose = 0
_stack = ""
_stock_id = 0
print "====== Grass on AWK 0.06 ======"
push("E")
push("/@in")
push(119) #"w"
push("/@succ")
push("/@out")
true_func = "/2[0]0.2,"
false_func = "/2[0]0.1,"
# ソース読み込み
while (getline < srcfile > 0) {
## 前処理
gsub(/Ｗ/,"W")
gsub(/ｗ/,"w")
gsub(/[^Ww]/,"")
# 文をパース
if (verbose) printf("%s => %s\n", $0, pp($0));
## Function:
if (/^w/) {
N = split(read($0), ar, " ") # odd
if (verbose) print "function."
stock_id = stock(_stack)
js = "/" ar[1] "[" _stock_id "]"
for (i=2; i<=N; i+=2) {
js = js ar[i] "." ar[i+1] ","
}
push(js)
dump()
continue
}
## Applications:
if (/^W/) {
N = split(read($0), ar, " ") # even
if (verbose) printf "applications."
for (i=1; i<=N; i+=2) {
proc = st( ar[i] )
arg = st( ar[i+1] )
if (verbose) printf("%d) apply (%d %d) c-a-d. (%s %s) ...\n", i, ar[i], ar[i+1], proc, arg);
val = apply(proc, arg)
if (verbose) printf(" => %s\n", val);
push(val)
}
printf "\n"
continue
}
}
#
fn = arg = pop()
val = apply(fn, arg)
print ""
exit
}
#
# スタック関連の関数
#
function push(x)
{
if (verbose) print "push " x;
_stack = x ":" _stack
}
function pop( var,ix)
{
if (verbose) print "pop ";
ix = index(_stack,":")
if (ix > 0) {
var = substr(_stack, 1, ix-1)
_stack = substr(_stack, ix+1)
} else {
# スタックが空
print "ERROR: _stack is empty." > "/dev/stderr"
var = ""
}
if (verbose) printf(" => %s\n", var);
return var
}
function dump( N,a,i)
{
if (verbose) {
print "{"
N = split(_stack, a, /:/)
for (i=1; i<N; i++) print " - " a[i];
print "}"
}
}
function st(ix, N,a)
{
N = split(_stack, a, /:/)
if (1 <= ix && ix <= N) {
return a[ix]
} else {
print "ERROR: out of bounds." > "/dev/stderr"
return ""
}
}
function stock(stack)
{
_stack_stock[++_stock_id] = stack
return _stock_id
}
function stack_at(stock_id)
{
return _stack_stock[stock_id]
}
function is_primitive(fn)
{
return (fn ~ /^\/@/) ? 1 : 0
}
function arity_of(fn, b)
{
if (is_primitive(fn)) return 1 # /@out, /@in, /@succ
b = index(fn, "[")
return 0 + substr(fn, 2, b-2)
}
function env_of(fn, b,e)
{
b = index(fn,"[")
e = index(fn,"]")
stock_id = substr(fn, b+1, e-b-1)
return stack_at( stock_id )
}
function body_of(fn, e)
{
e = index(fn, "]")
return substr(fn, e+1)
}
function apply_primitive(fn,arg, name,line)
{
name = substr(fn,3)
if (name ~ /out/) {
if (verbose) printf "OUT:"
printf("%c", arg)
if (verbose) printf "\n"
return arg
} else if (name ~ /in/) {
getline line
return ord(substr(line,1,1))
} else if (name ~ /succ/) {
if (verbose) printf("succ %s(%c) => %s(%c)\n", arg,arg, (arg+1)%256,(arg+1)%256)
return (arg + 1) % 256 ###
}
}
function apply_cmp(fn,arg)
{
if (verbose) printf("APPLY COMPARISON/%d with arg:%s\n", fn, arg)
return (0+fn == 0+arg) ? true_func : false_func
}
function apply(fn,arg, ar,as,N,i, arity,env,new_env,body, proc,val,stack_bup, tmp)
{
if (verbose) printf("(apply %s %s...)\n", fn, substr(arg,1,10))
if (is_primitive(fn)) return apply_primitive(fn,arg)
if (fn ~ /^[0-9]/) return apply_cmp(fn,arg)
arity = arity_of(fn)
env = env_of(fn)
body = body_of(fn)
new_env = arg ":" env
if (arity > 1) {
stock_id = stock(new_env)
val = sprintf("/%d[%d]%s", arity-1, stock_id, body)
if (verbose) printf("＜部分適用＞ %s => %s\n", fn, val)
return val;
}
if (verbose) printf("= arity:%d, env:%s, body:%s\n", arity, env, body);
stack_bup = _stack
_stack = new_env
if (verbose) print "closure:"
dump()
if (verbose) print "APPLY: executing body: "
N = split(body,as,/,/);
if (verbose) printf("body\"%s\" => %d exprs\n", body,N-1)
for (i=1; i<N; i++) {
split(as[i], ar, /\./)
if (ar[1] == 0) {
if (verbose) printf("%d) boolean.\n", i)
val = st( ar[2] )
push(val)
dump()
} else {
proc = st( ar[1] )
arg = st( ar[2] )
dump()
if (verbose) printf("%d) apply (%d %d) c-a-d. (%s %s) ...\n", i, ar[1], ar[2], proc, arg);
val = apply(proc, arg)
if (verbose) printf(" => %s\n", val);
push(val)
}
}
if (verbose) print "body end."
dump()
val = pop()
_stack = stack_bup
return val
}
#
# wWWwWww --> 1 2 1 1 2
# www --> 3
# WWww -> 2 1
#
function read(s, res, last,len,cnt,i,c)
{
last = ""
res = ""
cnt = ""
len = length(s)
for (i=1; i<=len; i++) {
c = substr(s,i,1)
if (c == last) {
cnt++
} else {
last = c
res = res " " cnt
cnt = 1
}
}
res = res " " cnt
gsub(/^ +/,"",res)
return res
}
function ord(ch, ofs)
{
if (ch == "\t") return 9
if (ch == "\n") return 13
# if (ch == "@") return 64
ofs = index(" !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\\\]^_`abcdefghijklmnopqrstuvwxyz{|}~", ch)
return ofs ? 31 + ofs : 0
}
function pp(s, res, N,arr,i)
{
res = ""
N = split(read(s), arr, " ")
if (substr(s,1,1) == "w") {
res = "(function /" arr[1] ""
i = 2
} else {
res = "(applications"
i = 1
}
for (; i<=N; i+=2) {
res = res sprintf(" (%d, %d)", arr[i], arr[i+1])
}
return res ")"
}
(16:53)
