Added TypeIndices sample projects

Author: erikvanbilsen

TypeIndices/SimpleTypeIndex.dpr

@@ -0,0 +1,135 @@
+program SimpleTypeIndex;
+
+{$APPTYPE CONSOLE}
+
+{$R *.res}
+
+uses
+  System.SysUtils,
+  System.Classes;
+
+type
+  { Utility to generate type indices (partiallly) at compile time }
+  TTypeIndex<T> = class // static
+  private
+    class var FValue: Integer;
+  public
+    class constructor Create;
+
+    { Returns the type index for the type parameter T }
+    class property Value: Integer read FValue;
+  end;
+
+var
+  GNextTypeIndex: Integer = 0;
+
+{ TTypeIndex<T> }
+
+class constructor TTypeIndex<T>.Create;
+begin
+  FValue := GNextTypeIndex;
+  Inc(GNextTypeIndex);
+end;
+
+type
+  TIntegerAlias = Integer;
+  TDistinctInteger = type Integer;
+
+{ TypeIndexExample }
+
+procedure TypeIndexExample;
+begin
+  WriteLn('Index for type Integer: ', TTypeIndex<Integer>.Value);
+  WriteLn('Index for type String: ', TTypeIndex<String>.Value);
+  WriteLn('Index for type TStream: ', TTypeIndex<TStream>.Value);
+
+  { To check if the type index for String is still the same as before: }
+  WriteLn('Index for type String: ', TTypeIndex<String>.Value);
+
+  { Type aliases have the same index as their aliased type: }
+  WriteLn('Index for type TIntegerAlias: ', TTypeIndex<TIntegerAlias>.Value);
+
+  { Discinct types will have their own unique index though: }
+  WriteLn('Index for type TDistinctInteger: ', TTypeIndex<TDistinctInteger>.Value);
+end;
+
+type
+  TTypeMap = record
+  private
+    FBits: UInt32;
+  public
+    procedure Init; inline;
+    procedure Include<T>; inline;
+    procedure Exclude<T>; inline;
+    function Has<T>: Boolean; inline;
+  end;
+
+{ TTypeMap }
+
+procedure TTypeMap.Init;
+begin
+  FBits := 0;
+end;
+
+procedure TTypeMap.Include<T>;
+var
+  Index: Integer;
+begin
+  Index := TTypeIndex<T>.Value;
+  Assert(Index < 32);
+  FBits := FBits or (1 shl Index);
+end;
+
+procedure TTypeMap.Exclude<T>;
+var
+  Index: Integer;
+begin
+  Index := TTypeIndex<T>.Value;
+  Assert(Index < 32);
+  FBits := FBits and not (1 shl Index);
+end;
+
+function TTypeMap.Has<T>: Boolean;
+var
+  Index: Integer;
+begin
+  Index := TTypeIndex<T>.Value;
+  Assert(Index < 32);
+  Result := ((FBits and (1 shl Index)) <> 0);
+end;
+
+{ TypeMapExample }
+
+procedure TypeMapExample;
+var
+  TypeMap: TTypeMap;
+begin
+  TypeMap.Init;
+
+  { "Register" Integer and TStream types }
+  TypeMap.Include<Integer>;
+  TypeMap.Include<TStream>;
+
+  Assert(TypeMap.Has<Integer>);
+  Assert(TypeMap.Has<TStream>);
+  Assert(not TypeMap.Has<String>);
+
+  { "Unregister" Integer type }
+  TypeMap.Exclude<Integer>;
+
+  Assert(not TypeMap.Has<Integer>);
+  Assert(TypeMap.Has<TStream>);
+end;
+
+{ Entry Point }
+
+begin
+  try
+    TypeIndexExample;
+    TypeMapExample;
+    ReadLn;
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end;
+end.

TypeIndices/SimpleTypeIndex.dproj

@@ -0,0 +1,79 @@
+program TwoLevelTypeIndex;
+
+{$APPTYPE CONSOLE}
+
+{$R *.res}
+
+uses
+  System.SysUtils;
+
+type
+  TTypeIndex<TCategory> = class // static
+  private type
+    TIndex<T> = class // static
+    private
+      class var FValue: Integer;
+    public
+      class constructor Create;
+    end;
+  private
+    class var FNextIndex: Integer;
+  public
+    class constructor Create;
+  public
+    class function Get<T>: Integer; inline; static;
+  end;
+
+{ TTypeIndex<TCategory> }
+
+class constructor TTypeIndex<TCategory>.Create;
+begin
+  FNextIndex := 0;
+end;
+
+class function TTypeIndex<TCategory>.Get<T>: Integer;
+begin
+  Result := TIndex<T>.FValue;
+end;
+
+{ TTypeIndex<TCategory>.TIndex<T> }
+
+class constructor TTypeIndex<TCategory>.TIndex<T>.Create;
+begin
+  FValue := FNextIndex;
+  Inc(FNextIndex);
+end;
+
+{ TypeIndexExample }
+
+type
+  TCategory1 = type Integer;
+  TCategory2 = type Integer;
+
+procedure TypeIndexExample;
+begin
+  WriteLn('Type index for category 1, type Integer: ',
+    TTypeIndex<TCategory1>.Get<Integer>);
+
+  WriteLn('Type index for category 1, type Single: ',
+    TTypeIndex<TCategory1>.Get<Single>);
+
+  WriteLn('Type index for category 1, type String: ',
+    TTypeIndex<TCategory1>.Get<String>);
+
+  WriteLn('Type index for category 1, type Single: ',
+    TTypeIndex<TCategory1>.Get<Single>);
+
+  WriteLn('Type index for category 2, type Single: ',
+    TTypeIndex<TCategory2>.Get<Single>);
+end;
+
+begin
+  try
+    TypeIndexExample;
+    ReadLn;
+  except
+    on E: Exception do
+      Writeln(E.ClassName, ': ', E.Message);
+  end;
+end.