DelFusa Blog 総本山

プログラミングの話題とかです。

NEW | PAGE-SELECT | NEXT

≫ EDIT

スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

| スポンサー広告 | --:-- | comments(-) | trackbacks(-) | TOP↑

≫ EDIT

String可能なCase文



     ∧,,∧       今日モ ハード コーディングダゼ!
     ミ,, ゚∀゚彡     
     〃つ_つ/  ̄ ̄ ̄/ ガリガリ イクゼ
   ~ミ,,, ,,|\ ./シンクパド/
       '\/.======./
           ̄ ̄ ̄


無名メソッドを使って、こんな芸当してみました。無理矢理ですけどね。

以前からDelphiでは
case文でStringの比較出来ないのがちょっと残念に思っていまして

数日前から、こんなの作れば動くかな。と思って妄想が広がっていたので
作ってみました。


こんなSELECT構文が使えます。


procedure TForm1.Button1Click(Sender: TObject);
begin
with select<string>.value('def') do
begin
same(['abc'], procedure
begin
ShowMessage('abc');
end);

same(['def'], procedure
begin
ShowMessage('def');
end);

same(['abc', 'def'], procedure
begin
ShowMessage('abc or def');
end);

same_else(procedure
begin
ShowMessage('else');
end);
end;
end;


無名メソッドを使うと通常は
procedureを括弧で囲う書き方になってしまうので、なんとも微妙な感じに拡張構文っぽくない。
括弧の中に書くのが、躊躇を誘うんだよ。

ということで、いつものプロパティ代入形式の無名メソッドといきましょう。


procedure TForm1.Button2Click(Sender: TObject);
begin
with select<string>.value('abc') do
begin
block[equal('abc')] := procedure
begin
ShowMessage('abc');
end;

block[equal('def')] := procedure
begin
ShowMessage('def');
end;

block[equal(['abc', 'def'])] := procedure
begin
ShowMessage('abc or def');
end;

block_else := procedure
begin
ShowMessage('else');
end;
end;
end;


どーよ。っていうほど、どーよ、ではないのだが、一応こんな書き方もできました。
ってところですね。

CASEって単語が使えなかったので、SELECTにしちゃいました。
VB風だから、ださい感かな。そのあたりは気にくわなければ変更どぞー。
構文や関数名などは、いつも迷いまくります。


さてさて、実装です。
どっちの構文も同じクラスで実装してみました。
sameでも、block equal、どちらつかってもOK


type
select<TResult> = record
private
FValue: TResult;
FExecuteFlag: Boolean;
procedure Setblock(Compare: Boolean; const Value: TProc);
public
constructor value(value1: TResult);
procedure same(conditions: array of TResult; Proc: TProc);
procedure same_else(Proc: TProc);

function equal(Value: TResult): Boolean; overload;
function equal(Value: array of TResult): Boolean; overload;
property block[Compare: Boolean]: TProc write Setblock;
property block_else: TProc write same_else;
end;

constructor select<TResult>.value(value1: TResult);
begin
FValue := value1;
FExecuteFlag := False;
end;

procedure select<TResult>.same(conditions: array of TResult; Proc: TProc);
var
Flag: Boolean;
I: Integer;
begin
Flag := equal(conditions);

if Flag then
begin
Proc;
FExecuteFlag := True;
end;
end;

procedure select<TResult>.same_else(Proc: TProc);
begin
if FExecuteFlag = False then
begin
Proc;
end;
end;

procedure select<TResult>.Setblock(Compare: Boolean; const Value: TProc);
begin
if Compare then
begin
Value;
FExecuteFlag := True;
end;
end;

function select<TResult>.equal(Value: TResult): Boolean;
begin
Result := False;
if TEqualityComparer<TResult>.Default.Equals(Value, FValue) then
Result := True;
end;

function select<TResult>.equal(Value: array of TResult): Boolean;
var
I: Integer;
begin
Result := False;
for I := Low(Value) to High(Value) do
begin
if TEqualityComparer<TResult>.Default.Equals(Value[I], FValue) then
begin
Result := True;
Break;
end;
end;
end;


単語を短くするとかそういう以前に様々な理由で記述が冗長すぎて、実用とはほど遠い感じもします。
withを使うのを、どうにも避けられなかったです。

あと、ジェネリクスも使ってるけど、実質、stringしか使わない気がする。

技術的に詰まりまくった点は、

配列プロパティのインデクサ。

type
select<TResult> = record
private
FValue: TResult;
procedure Setblock(condition: TResult; const Value: TProc); overload;
procedure Setblock(condition1, condition2: TResult; const Value: TProc); overload;
public
constructor value(value1: TResult);
property block[condition: TResult]: TProc write Setblock; default;
property block[condition1, condition2: TResult]: TProc write Setblock; default;
end;

こんな風にオーバーロードしてもこのソースのコンパイルは通るけど
呼び出そうと思っても呼び出し側がコンパイル通らないという不思議状況に陥ります。

デフォルトプロパティのオーバーロード使用については微妙な不安定さがありますね。
全力わはーさんところで語られている事が、こういうはなしかな。


そんでもって、もう一つ。

type
select<TResult> = record
private
FValue: TResult;
procedure Setblock(conditions: array of TResult; const Value: TProc);
public
constructor value(value1: TResult);
property block[conditions: array of TResult]: TProc write Setblock;
end;


こんな風にしても、blockプロパティとSetblockの型が違うと怒られてコンパイルが通らない。
オープンハイレツパラメータをプロパティのインデクサにはできないのね。
これも、きっとコンパイラ仕様漏れだろーー、と悲しくなりながら、不採用。

TResultDynArrayを指定すると、呼び出し側から使いにくすぎる話だから、当然不採用。

ということで、今の実装になってます。

このセレクトクラス。

block equal A
block equal A B
block equal A B C

と書いていて、Aという値だと全部の実装コードが動いてしまうので
case文というよりは if then の羅列な感じがします。
if thenで連続させた方が綺麗ですな....

まあ、お遊びということで、どーぞですよ。


参考
Delphi ジェネリクス - au2010の日記
http://d.hatena.ne.jp/au2010/20101125/1290684677


バリアント型は最適化されますか?|freeml byGMO
http://www.freeml.com/delphi-users/1505/latest


プロパティのオーバーロード。 - 全力わはー
http://d.hatena.ne.jp/tales/20100121/1264002096


スポンサーサイト

| 未分類 | 08:10 | comments:1 | trackbacks(-) | TOP↑

COMMENT

なんか、おかしいと思ったら、ジェネリクス構文がHTMLのタグ扱いで消えてやがるので、修正します。

| ミ・д・彡 | 2011/12/13 23:36 | URL | ≫ EDIT















非公開コメント

PREV | PAGE-SELECT | NEXT

上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。