順序型以外でも使える Case 文

Switches.pas

(*
 * Switches
 *   Case sentence with Anytype !
 *
 * Copyright (c) 2015 HOSOKAWA Jun.
 *
 * CONTACT
 *   Twitter @pik or freeonterminate@gmail.com
 *
 * LAST UPDATE
 *   2015/12/01  First Release
 *
 * PLATFORM
 *   Windows, OS X, iOS, Android
 *   Delphi (XE5, XE6, XE7 <- maybe) XE8, 10 seattle
 *     Maybe, Appmethod and C++Builder
 *
 * ORIGINAL SOURCE
 *   https://github.com/freeonterminate/delphi/tree/master/switches
 *
 * HOW TO USE
 *   1. uses Switches;
 *   2. Switch<TYPE>(Value) or TAG - procedure or TAG - procedure ...
 *      or
 *      SwitchStr(StringValue) or TAG - procedure or TAG - procedure ...
 *
 * EXAMPLE
 *   // Exsample 1 ---------------------------------------------
 *   // String
 *   // Output -> hello, world!
 *
 *   SwitchStr('hello')
 *     // Simple
 *     or 'Foo' - (procedure
 *     begin
 *       Writeln('FooFighters');
 *     end)
 *
 *     or 'hello' - (procedure     // Match !
 *     begin
 *       Writeln('hello, world!');
 *     end)
 *
 *     // Multi
 *     or '012'
 *     or '34567'
 *     or '89' - (procedure
 *     begin
 *       Writeln('Numbers');
 *     end)
 *
 *     // Can use Varible & Function
 *     or (function: String begin Result := 'Bar' end)()
 *     or sLineBreak - (procedure
 *     begin
 *       Writeln('Variable & Function');
 *     end);
 *
 *   // Exsample 2 ---------------------------------------------
 *   // Custom Comparer
 *   // Output -> BAR
 *
 *   SwitchStr('bar')
 *     .SetComparer(
 *       function(const L, R: String): Boolean
 *       begin
 *         Result := L.ToUpper = R.ToUpper
 *       end
 *     )
 *
 *     or 'FOO' - (procedure
 *     begin
 *       Writeln('FOO');
 *     end)
 *
 *     or 'BAR' - (procedure // Match !
 *     begin
 *       Writeln('BAR');
 *     end)
 *
 *     or 'BUZ' - (procedure
 *     begin
 *       Writeln('BAZ');
 *     end);
 *
 *   // Exsample 3 ---------------------------------------------
 *   // Single and C style switch-case
 *   // Output -> 1.0
 *   //           1.1
 *
 *   type
 *     SwitchSingle = Switch<Single>;
 *
 *   SwitchSingle(1.0).CStyle
 *     or 1.0 - (procedure    // Match !
 *     begin
 *       Writeln('1.0');
 *     end)
 *
 *     or 1.1 - (procedure    // Into !
 *     begin
 *       Writeln('1.1');
 *       SwitchSingle.Break;  // Break
 *     end)
 *
 *     or 1.2 - (procedure
 *     begin
 *       Writeln('1.2');
 *     end);
 *
 * LICENSE:
 *   本ソフトウェアは「現状のまま」で、明示であるか暗黙であるかを問わず、
 *   何らの保証もなく提供されます。
 *   本ソフトウェアの使用によって生じるいかなる損害についても、
 *   作者は一切の責任を負わないものとします。
 *
 *   以下の制限に従う限り、商用アプリケーションを含めて、本ソフトウェアを
 *   任意の目的に使用し、自由に改変して再頒布することをすべての人に許可します。
 *
 *   1. 本ソフトウェアの出自について虚偽の表示をしてはなりません。
 *      あなたがオリジナルのソフトウェアを作成したと主張してはなりません。
 *      あなたが本ソフトウェアを製品内で使用する場合、製品の文書に謝辞を入れて
 *      いただければ幸いですが、必須ではありません。
 *
 *   2. ソースを変更した場合は、そのことを明示しなければなりません。
 *      オリジナルのソフトウェアであるという虚偽の表示をしてはなりません。
 *
 *   3. ソースの頒布物から、この表示を削除したり、表示の内容を変更したりしては
 *      なりません。
 *
 *   This software is provided 'as-is', without any express or implied warranty.
 *   In no event will the authors be held liable for any damages arising from
 *   the use of this software.
 *
 *   Permission is granted to anyone to use this software for any purpose,
 *   including commercial applications, and to alter it and redistribute
 *   it freely, subject to the following restrictions:
 *
 *   1. The origin of this software must not be misrepresented;
 *      you must not claim that you wrote the original software.
 *      If you use this software in a product, an acknowledgment in the product
 *      documentation would be appreciated but is not required.
 *
 *   2. Altered source versions must be plainly marked as such,
 *      and must not be misrepresented as being the original software.
 *
 *   3. This notice may not be removed or altered from any source distribution.
 *)

unit Switches;

interface

uses
  System.SysUtils;

type
  Switch<T> = record
  public type
    TComparer = function (const ALeft, ARight: T): Boolean;
    TComparerRef = reference to function (const ALeft, ARight: T): Boolean;
  private class var
    FValue: T;
    FEqual: Boolean;
    FIsCStyle: Boolean;
    FComparer: TComparer;
    FComparerRef: TComparerRef;
  private
    class function Compare(const ALeft, ARight): Boolean; static;
  public
    // C styles
    class function CStyle: Switch<T>; static;
    class procedure Break; static;
    // Comparers
    class function SetComparer(
      const AComparer: TComparer): Switch<T>; overload; static;
    class function SetComparer(
      const AComparerRef: TComparerRef): Switch<T>; overload; static;
    // Operators
    class operator Implicit(const AValue: T): Switch<T>;
    class operator LogicalOr(
      const ALeft: Switch<T>;
      const ARight: T): Switch<T>;
    class operator Subtract(
      const ALeft: Switch<T>;
      const ARight: TProc): Switch<T>;
  end;

  SwitchStr = Switch<String>;

implementation

uses
  System.TypInfo
  , System.Rtti
  ;

{ Switch }

class procedure Switch<T>.Break;
begin
  FIsCStyle := False;
end;

class function Switch<T>.Compare(const ALeft, ARight): Boolean;
begin
  if (Assigned(FComparer)) then
    Result := FComparer(T(ALeft), T(ARight))

  else if (Assigned(FComparerRef)) then
    Result := FComparerRef(T(ALeft), T(ARight))

  else
  begin
    Result := False;

    case (GetTypeKind(T)) of
      TTypeKind.tkInteger,
      TTypeKind.tkPointer,
      TTypeKind.tkClass,
      TTypeKind.tkClassRef:
        Result := Integer(ALeft) = Integer(ARight);

      TTypeKind.tkEnumeration:
        Result := Byte(ALeft) = Byte(ARight);

      TTypeKind.tkInt64:
        Result := Int64(ALeft) = Int64(ARight);

      TTypeKind.tkUString:
        Result := String(ALeft) = String(ARight);

      {$IFNDEF NEXTGEN} // = {$IF not defined(ANDROID) and not defined(IOS)}
      TTypeKind.tkString:
        Result := ShortString(ALeft) = ShortString(ARight);

      TTypeKind.tkLString:
        Result := AnsiString(ALeft) = AnsiString(ARight);

      TTypeKind.tkWString:
        Result := WideString(ALeft) = WideString(ARight);

      TTypeKind.tkChar:
        Result := AnsiChar(ALeft) = AnsiChar(ARight);
      {$ENDIF}

      TTypeKind.tkWChar:
        Result := WideChar(ALeft) = WideChar(ARight);

      TTypeKind.tkFloat:
        case SizeOf(T) of
          4:
            Result := Single(ALeft) = Single(ARight);
          6:
            Result := Real48(ALeft) = Real48(ARight);
          8:
            Result := Double(ALeft) = Double(ARight);
          10:
            Result := Extended(ALeft) = Extended(ARight);
        end;
    end;
  end;
end;

class function Switch<T>.CStyle: Switch<T>;
begin
  FIsCStyle := True;
end;

class operator Switch<T>.Implicit(const AValue: T): Switch<T>;
begin
  FValue := AValue;
  FEqual := False;
  FIsCStyle := False;
end;

class operator Switch<T>.LogicalOr(
  const ALeft: Switch<T>;
  const ARight: T): Switch<T>;
begin
  FEqual := FEqual or Compare(FValue, ARight);
end;

class function Switch<T>.SetComparer(const AComparer: TComparer): Switch<T>;
begin
  FComparer := AComparer;
end;

class function Switch<T>.SetComparer(
  const AComparerRef: TComparerRef): Switch<T>;
begin
  FComparerRef := AComparerRef;
end;

class operator Switch<T>.Subtract(
  const ALeft: Switch<T>;
  const ARight: TProc): Switch<T>;
begin
  if (FEqual) then
  begin
    ARight;
    FEqual := FIsCStyle;
  end;
end;

end.