まだ重たいCMSをお使いですか?
毎秒1000リクエスト を捌く超高速CMS「adiary

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

*1 : <$begin>~<$end>構文には、関数として展開される場合と埋め込みとして直接展開されるパターンがある。元々は関数展開しかなっかたものを、高速化のため部分的に直接展開を取り入れたことが複雑化の原因。

スケルトンの実行コード

ついでに。このスケルトンは次のような実行コード(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

なお出力を文字列連結せずスタックに積んでいくのは、高速化のためです。(コンパイラが)無駄に綺麗なソースを出力するのは単なる趣味です(笑)

*2 : すでにキャッシュされているスケルトンはコンパイルの必要がないためログは出力されません。キャッシュを消すか何かしてください。