2008/02/05(火)skltonシステムで再帰関数
最近書いた、adiary関連のとあるskeltonで必要に迫られて再帰関数を作りました。
再帰関数なスケルトン
<@local(ary, subdir, prefix, depth, header, idx, x)> <@>再帰サブルーチン -------------------------------------------- <$sub = begin)> <$subdir = argv#1> <$prefix = argv#2> <$depth = argv#3> <$header = if(depth, '<img width=' . (9*depth) . #' height="9" src="<@Basepath><@v.album_icons>spacer.gif">')> <$idx = 0> <@forexec(t, argv#0, begin)> <$push(dirlist, t)> <$ary = v.search_folderlist(basedir, t.path, t.pathname)> <$uri_encode(x = t.path)><@>URIエンコード済パス / ""内に書いても安全にする <@ifexec(ary#0, begin, begin)> <@header><a href="#" onClick="return toggleBlock('<@prefix><@idx>');"> <img src="<@Basepath><@v.album_icons>minus.png" id="img_<@prefix><@idx>"></a> -<a href="<@v.myself2><@x>"><@t.name></a><br> <div id="blk_<@prefix><@idx>"."_"> <@exec(sub, ary, "<@t.path>", "<@prefix><@idx>_", depth+1)> </div> <$else> <@header>+-<a href="<@v.myself2><@x>"><@t.name></a><br> <$end> <$idx+=1> <$end> <$end> <@>main --------------------------------------------------------- <$dirlist = argv#0> <$basedir = v.user_dir> <@exec(sub, v.search_folderlist(v.user_dir), "", "blk_", 0)>
ローカル変数宣言に再起関数。ここまでくるとすでにスケルトンではないような気もしますが、viewに関連する部分はプログラム本体には入れたくないので、こんな感じです。
このとおり Satsuki-system はかなり強力ですが、もう少し記述能力をアップさせたいところではあります。
<@x=forexec(t, v.load_folderlist(), begin)>
とかできませんし、ローカル変数宣言もファイル全体に対する宣言となっているにも関わらず、実装は関数単位分離になるため、かなり理解しにくいところがあります。*1
スケルトンの実行コード
ついでに。このスケルトンは次のような実行コード(Perl)にコンパイルされた後、__cache/ ディレクトリ以下に保存されます。
sub { my $Out = shift; my $R = shift; my $Ary = shift; my $v = $R->{v}; $_[1] = \$v; my ($x,$idx,$depth,$header,$prefix,$subdir,$ary); $R->{sub} = $Ary->[1]; $R->{dirlist} = $R->{argv}->[0]; $R->{basedir} = $v->{user_dir}; $_[0]=38; push(@$Out, $R->exec($R->{sub},$v->search_folderlist($v->{user_dir}),"","blk_",0)); $R->{Break} && return; return; } sub { my $Out = shift; my $R = shift; my $Ary = shift; my $v = $R->{v}; $_[1] = \$v; my ($x,$idx,$depth,$header,$prefix,$subdir,$ary); my $subdir = $R->{argv}->[1]; my $prefix = $R->{argv}->[2]; my $depth = $R->{argv}->[3]; my $header = ($depth != 0 && (('<img width=' . (9 * $depth)) . " height=\"9\" src=\"$R->{Basepath}$v->{album_icons}spacer.gif\">")); my $idx = 0; my $X=$R->{argv}->[0]; if (ref($X) ne 'ARRAY') { $X=[]; $R->error_from("line 17 at $R->{__src_file}", '[executor] forexec: data is not array'); }; foreach(@{ $X }) { $R->{t}=$_; $_[0]=18; push(@{$R->{dirlist}},$R->{t}); $_[0]=19; my $ary = $v->search_folderlist($R->{basedir},$R->{t}->{path},$R->{t}->{pathname}); $R->{Break} && return; $_[0]=20; $R->uri_encode(($x = $R->{t}->{path})); $R->{Break} && return; if ($ary->[0]) { push(@$Out, $header); push(@$Out, '<a href="#" onClick="return toggleBlock(\''); push(@$Out, $prefix); push(@$Out, $idx); push(@$Out, '\');"><img src="'); push(@$Out, $R->{Basepath}); push(@$Out, $v->{album_icons}); push(@$Out, 'minus.png" id="img_'); push(@$Out, $prefix); push(@$Out, $idx); push(@$Out, '"></a>-<a href="'); push(@$Out, $v->{myself2}); push(@$Out, $x); push(@$Out, '">'); push(@$Out, $R->{t}->{name}); push(@$Out, '</a><br> <div id="blk_'); push(@$Out, $prefix); push(@$Out, $idx); push(@$Out, '_"> '); $_[0]=24; push(@$Out, $R->exec($R->{sub},$ary,"$R->{t}->{path}",("$prefix$idx" . "_"),($depth + 1))); $R->{Break} && return; push(@$Out, '</div> '); } else { push(@$Out, $header); push(@$Out, '+-<a href="'); push(@$Out, $v->{myself2}); push(@$Out, $x); push(@$Out, '">'); push(@$Out, $R->{t}->{name}); push(@$Out, '</a><br> '); } $idx += 1; } return; }
これはコンパイルログディレクトリ <$Compile_log_dir="xxx"> を設定することで誰でもみることが出来ます。*2
なお出力を文字列連結せずスタックに積んでいくのは、高速化のためです。(コンパイラが)無駄に綺麗なソースを出力するのは単なる趣味です(笑)