I am trying to create a nullable data type in Delphi:
type
TNullable<T> = record
public
Value: T;
IsNull: Boolean;
class operator Implicit(const AValue: T): TNullable<T>;
class operator Implicit(const AValue: TNullable<T>): T;
class operator Implicit(const AValue: Variant): TNullable<T>;
class operator Explicit(const AValue: T): TNullable<T>;
end;
So far so good, but what to assign as a null literal so that the nullable data type remains of its basic type? For example:
var
v: TNullable<Integer>;
begin
//What type is this "null"? A Variant null?
//How TNullable<Integer> could remain of Integer after the assignment?
v := null;
//How to compare this "null"? Compare to what type?
if v = null then begin
end;
end;
Let us assume that null is the variant null:
class operator TNullable<T>.Implicit(const AValue: Variant): TNullable<T>;
begin
if VarIsNull(AValue) or VarIsClear(AValue) then begin
Result.IsNull := True;
Result.Value := Default(T);
end
else begin
Result.IsNull := False;
Result.Value := AValue; //Version 1: Incompatible types: 'T' and 'Variant'!!!
Result.Value := T(AValue); //Version 2: Invalid typecast!!!
//Should I write a big "case" block here in order to handle each data type?!
end;
end;
Do you have ideas?
Null in this case is indeed a Variant, see System.Variants.Null. Using a Variant in this situation is not a good idea, in part because of the assignment troubles you are seeing with it.
A better option is to define a distinct type to represent your null values (similar to nullptr_t in C++11 and later), eg:
type
TNullValue = record
end;
TNullable<T{: record}> = record
public
Value: T;
HasValue: Boolean;
class operator Implicit(const AValue: T): TNullable<T>;
class operator Implicit(const AValue: TNullable<T>): T;
class operator Implicit(const AValue: TNullValue): TNullable<T>;
class operator Explicit(const AValue: T): TNullable<T>;
// add these...
class operator Equal(const A: TNullable<T>; const B: TNullValue): Boolean;
class operator NotEqual(const A: TNullable<T>; const B: TNullValue): Boolean;
...
end;
const
NullValue: TNullValue;
...
class operator TNullable<T>.Implicit(const AValue: T): TNullable<T>;
begin
Result.Value := AValue;
Result.HasValue := True;
end;
class operator TNullable<T>.Implicit(const AValue: TNullable<T>): T;
begin
if AValue.HasValue then
Result := AValue.Value
else
Result := Default(T); // or raise an exception
end;
class operator TNullable<T>.Implicit(const AValue: TNullValue): TNullable<T>;
begin
Result.Value := Default(T);
Result.HasValue := False;
end;
class operator TNullable<T>.Explicit(const AValue: T): TNullable<T>;
begin
Result.Value := AValue;
Result.HasValue := True;
end;
class operator TNullable<T>.Equal(const A: TNullable<T>; const B: TNullValue): Boolean;
begin
Result := not A.HasValue;
end;
class operator TNullable<T>.NotEqual(const A: TNullable<T>; const B: TNullValue): Boolean;
begin
Result := A.HasValue;
end;
var
v: TNullable<Integer>;
begin
v := NullValue;
if v = NullValue then begin
...
end;
if v <> NullValue then begin
...
end;
end;
In Delphi 10 Berlin under Windows I have the following question regarding the freeing of generic lists:
I have the following record/list structure:
type
TMyRecord=record
Value1: Real;
SubList1: TList<Integer>;
SubList2: TList<Real>;
end;
TMyListOfRecords=TList<TMyRecord>;
I want to free the structure with the following code:
var
i: Integer;
AMyListOfRecords: TMyListOfRecords;
begin
//other code
//free AMyListOfRecords and all its content
for i:=0 to AMyListOfRecords.Count-1 do
begin
AMyListOfRecords[i].SubList1.Free;
AMyListOfRecords[i].SubList2.Free;
end;
AMyListOfRecords.Free;
end;
This seems to work. But I am wondering if there is a simpler or more elegant solution?
You could transform record type to class - overhead is negligible because record already contains sub-objects. Free sub-objects in this class destructor, and use
TMyListOfClasses = TObjectList<TMyClass>;
with OwnsObjects = True
In this case all you need is
AMyListOfClasses.Free;
You can define the interfaced list for the sub-items like:
type
TMyRecord=record
Value1: Real;
SubList1: IList<Integer>;
SubList2: IList<Real>;
end;
TMyListOfRecords=TList<TMyRecord>;
Where IList is kind of:
type
IList<T> = interface
function Add(const AValue: T): Integer;
function Remove(AValue: T): Integer;
end;
where you implement it like this:
TIntfList<T> = class(TInterfacedObject, IList<T>)
private
FList: TList<T>;
function Add(const AValue: T): Integer;
function Remove(AValue: T): Integer;
constructor Create;
destructor Destroy; override;
end;
{ TIntfList<T> }
function TIntfList<T>.Add(const AValue: T): Integer;
begin
Result := FList.Add(AValue);
end;
constructor TIntfList<T>.Create;
begin
FList := TList<T>.Create;
end;
destructor TIntfList<T>.Destroy;
begin
FList.Free;
inherited;
end;
function TIntfList<T>.Remove(AValue: T): Integer;
begin
Result := FList.Remove(AValue);
end;
After that you can assign fields of your record with TIntfList.Create and they will be released automatically with your records.
I have a Generic class which uses an Enum Generic Type. My problem how do I use GetEnumName on an instance of that type?
I've created a small demo class to illustrate the problem:
type
TEnumSettings<TKey: record > = class
private
Key: TKey;
public
constructor Create(aKey: TKey);
function ToString: string; override;
end;
uses
TypInfo;
{ TEnumSettings<TKey> }
constructor TEnumSettings<TKey>.Create(aKey: TKey);
begin
if PTypeInfo(System.TypeInfo(TKey)).Kind <> tkEnumeration then
Exception.Create(string(PTypeInfo(System.TypeInfo(TKey)).Name) + ' is not an Enumeration');
Key := aKey;
end;
function TEnumSettings<TKey>.ToString: string;
begin
Result := GetEnumName(System.TypeInfo(TKey), Integer(Key)) <== HERE I get a compile error: Invalid type cast
end;
I'm using Delphi XE. So can this be done? And if so how?
Personally, I would do this with a call to Move. I have the following type:
type
TEnumeration<T: record> = class
strict private
class function TypeInfo: PTypeInfo; inline; static;
class function TypeData: PTypeData; inline; static;
public
class function IsEnumeration: Boolean; static;
class function ToOrdinal(Enum: T): Integer; inline; static;
class function FromOrdinal(Value: Integer): T; inline; static;
class function MinValue: Integer; inline; static;
class function MaxValue: Integer; inline; static;
class function InRange(Value: Integer): Boolean; inline; static;
class function EnsureRange(Value: Integer): Integer; inline; static;
end;
{ TEnumeration<T> }
class function TEnumeration<T>.TypeInfo: PTypeInfo;
begin
Result := System.TypeInfo(T);
end;
class function TEnumeration<T>.TypeData: PTypeData;
begin
Result := TypInfo.GetTypeData(TypeInfo);
end;
class function TEnumeration<T>.IsEnumeration: Boolean;
begin
Result := TypeInfo.Kind=tkEnumeration;
end;
class function TEnumeration<T>.ToOrdinal(Enum: T): Integer;
begin
Assert(IsEnumeration);
Assert(SizeOf(Enum)<=SizeOf(Result));
Result := 0; // needed when SizeOf(Enum) < SizeOf(Result)
Move(Enum, Result, SizeOf(Enum));
Assert(InRange(Result));
end;
class function TEnumeration<T>.FromOrdinal(Value: Integer): T;
begin
Assert(IsEnumeration);
Assert(InRange(Value));
Assert(SizeOf(Result)<=SizeOf(Value));
Move(Value, Result, SizeOf(Result));
end;
class function TEnumeration<T>.MinValue: Integer;
begin
Assert(IsEnumeration);
Result := TypeData.MinValue;
end;
class function TEnumeration<T>.MaxValue: Integer;
begin
Assert(IsEnumeration);
Result := TypeData.MaxValue;
end;
class function TEnumeration<T>.InRange(Value: Integer): Boolean;
var
ptd: PTypeData;
begin
Assert(IsEnumeration);
ptd := TypeData;
Result := Math.InRange(Value, ptd.MinValue, ptd.MaxValue);
end;
class function TEnumeration<T>.EnsureRange(Value: Integer): Integer;
var
ptd: PTypeData;
begin
Assert(IsEnumeration);
ptd := TypeData;
Result := Math.EnsureRange(Value, ptd.MinValue, ptd.MaxValue);
end;
The ToOrdinal method does what you need, and I'm sure you'll be able to adapt it to your class.
If you don't like using Move in this way, then you can use TValue.
TValue.From<TKey>(Key).AsOrdinal
And #TLama points out that you can avoid calling GetEnumName at all by using
TValue.From<TKey>(Key).ToString
On the face of it, using TValue seems to be more in keeping with the ethos of generics and RTTI. A call to Move relies on the specific implementation details of enumerated types. However, it's quite interesting to step through the debugger and observe quite how much code is involved in executing TValue.From<TKey>(Key).AsOrdinal. That alone is enough to make me hesitate to recommend using TValue.
Yet another way to achieve this is to use TRttiEnumerationType:
TRttiEnumerationType.GetName<TKey>(Key)
The implementation of this is much more efficient than using TValue.ToString, being little more than a call to GetEnumName.
This is an updated version af my class, with the change suggested. Thanks to David and TLama
uses
TypInfo, Rtti;
type
TEnumSettings<TKey: record> = class
private
Key: TKey;
public
constructor Create(aKey: TKey);
function ToString: string; override;
end;
{ TEnumSettings<TKey> }
constructor TEnumSettings<TKey>.Create(aKey: TKey);
begin
if PTypeInfo(System.TypeInfo(TKey)).Kind <> tkEnumeration then
raise Exception.Create(string(PTypeInfo(System.TypeInfo(TKey)).Name) + ' is not an Enumeration');
Key := aKey;
end;
function TEnumSettings<TKey>.ToString: string;
begin
Result := TValue.From<TKey>(Key).ToString;
end;
And a little test example :
Copy the code into OnCreate of a From:
procedure TForm1.FormCreate(Sender: TObject);
begin
with TEnumSettings<boolean> .Create(True) do
try
Caption := ToString;
finally
Free;
end;
end;
When I use TObjectDictionary, where TKey is object, my application work uncorrectly.
I have two units, thats contain two classes. First unit:
unit RubTerm;
interface
type
TRubTerm = Class(TObject)
private
FRubricName: String;
FTermName: String;
public
property RubricName: String read FRubricName;
property TermName: String read FTermName;
constructor Create(ARubricName, ATermName: String);
end;
implementation
constructor TRubTerm.Create(ARubricName, ATermName: String);
begin
Self.FRubricName := ARubricName;
Self.FTermName := ATermName;
end;
end;
And second unit:
unit ClassificationMatrix;
interface
uses
System.Generics.Collections, System.Generics.Defaults, System.SysUtils, RubTerm;
type
TClassificationMatrix = class(TObject)
private
FTable: TObjectDictionary<TRubTerm, Integer>;
public
constructor Create;
procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName, ATermName: String);
function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer;
end;
implementation
constructor TClassificationMatrix.Create;
begin
FTable := TObjectDictionary<TRubTerm, Integer>.Create;
end;
procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName, ATermName: String);
var
ARubTerm: TRubTerm;
begin
ARubTerm := TRubTerm.Create(ARubName, ATermName);
FTable.Add(ARubTerm, ADocsCount);
end;
function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer;
var
ARubTerm: TRubTerm;
begin
ARubTerm := TRubTerm.Create(ARubName, ATermName);
FTable.TryGetValue(ARubTerm, Result);
end;
end;
But this fragment of code work unnormal:
procedure TestTClassificationMatrix.TestGetCount;
var
DocsCountTest: Integer;
begin
FClassificationMatrix.AddCount(10, 'R', 'T');
DocsCountTest := FClassificationMatrix.GetCount('R', 'T');
end;
// DocsCountTest = 0! Why not 10? Where is problem?
Thanks!
The fundamental issue here is that the default equality comparer for your type does not behave the way you want it to. You want equality to mean value equality, but the default comparison gives reference equality.
The very fact that you are hoping for value equality is a strong indication that you should be using a value type rather than a reference type. And that's the first change that I would suggest.
type
TRubTerm = record
RubricName: string;
TermName: string;
class function New(const RubricName, TermName: string): TRubTerm; static;
class operator Equal(const A, B: TRubTerm): Boolean;
class operator NotEqual(const A, B: TRubTerm): Boolean;
end;
class function TRubTerm.New(const RubricName, TermName: string): TRubTerm;
begin
Result.RubricName := RubricName;
Result.TermName := TermName;
end;
class operator TRubTerm.Equal(const A, B: TRubTerm): Boolean;
begin
Result := (A.RubricName=B.RubricName) and (A.TermName=B.TermName);
end;
class operator TRubTerm.NotEqual(const A, B: TRubTerm): Boolean;
begin
Result := not (A=B);
end;
I've added TRubTerm.New as a helper method to make it easy to initialize new instances of the record. And for convenience, you may also find it useful to overload the equality and inequality operators, as I have done above.
Once you switch to a value type, then you would also change the dictionary to match. Use TDictionary<TRubTerm, Integer> instead of TObjectDictionary<TRubTerm, Integer>. Switching to a value type will also have the benefit of fixing all the memory leaks in your existing code. Your existing code creates objects but never destroys them.
This gets you part way home, but you still need to define an equality comparer for your dictionary. The default comparer for a record will be based on reference equality since strings, despite behaving as value types, are stored as references.
To make a suitable equality comparer you need to implement the following comparison functions, where T is replaced by TRubTerm:
TEqualityComparison<T> = reference to function(const Left, Right: T): Boolean;
THasher<T> = reference to function(const Value: T): Integer;
I'd implement these as static class methods of the record.
type
TRubTerm = record
RubricName: string;
TermName: string;
class function New(const RubricName, TermName: string): TRubTerm; static;
class function EqualityComparison(const Left,
Right: TRubTerm): Boolean; static;
class function Hasher(const Value: TRubTerm): Integer; static;
class operator Equal(const A, B: TRubTerm): Boolean;
class operator NotEqual(const A, B: TRubTerm): Boolean;
end;
Implementing EqualityComparison is easy enough:
class function TRubTerm.EqualityComparison(const Left, Right: TRubTerm): Boolean;
begin
Result := Left=Right;
end;
But the hasher requires a little more thought. You need to hash each field individually and then combine the hashes. For reference:
Quick and Simple Hash Code Combinations
What is the canonical way to write a hasher function for TEqualityComparer.Construct?
The code looks like this:
{$IFOPT Q+}
{$DEFINE OverflowChecksEnabled}
{$Q-}
{$ENDIF}
function CombinedHash(const Values: array of Integer): Integer;
var
Value: Integer;
begin
Result := 17;
for Value in Values do begin
Result := Result*37 + Value;
end;
end;
{$IFDEF OverflowChecksEnabled}
{$Q+}
{$ENDIF}
function GetHashCodeString(const Value: string): Integer;
begin
Result := BobJenkinsHash(PChar(Value)^, SizeOf(Char) * Length(Value), 0);
end;
class function TRubTerm.Hasher(const Value: TRubTerm): Integer;
begin
Result := CombinedHash([GetHashCodeString(Value.RubricName),
GetHashCodeString(Value.TermName)]);
end;
Finally, when you instantiate your dictionary, you need to provide an IEqualityComparison<TRubTerm>. Instantiate your dictionary like this:
Dict := TDictionary<TRubTerm,Integer>.Create(
TEqualityComparer<TRubTerm>.Construct(
TRubTerm.EqualityComparison,
TRubTerm.Hasher
)
);
A Dictionary depends on a key value. You are storing a reference to an object in the key. If you create two objects that are setup identically the have different values and hence different keys.
var
ARubTerm1: TRubTerm;
ARubTerm2: TRubTerm;
begin
ARubTerm1 := TRubTerm.Create('1', '1');
ARubTerm2 := TRubTerm.Create('1', '1');
// ARubTerm1 = ARubTerm2 is not possible here as ARubTerm1 points to a different address than ARubTerm2
end;
Instead you could uses a String as the First Type Parameter in the TObjectDictonary that is based on RubricName and TermName. With this you would then get back the same value.
It should also be noted, that above code in XE2 creates two memory leaks. Every object created must be freed. Hence this section of code also is leaking memory
function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer;
var
ARubTerm: TRubTerm;
begin
ARubTerm := TRubTerm.Create(ARubName, ATermName);
FTable.TryGetValue(ARubTerm, Result);
end;
Given all of that. If you want to use an Object as a Key you can do it with a Custom Equality Comparer. Here is your example changed to implement IEqualityComparer<T>, and fix a few memory leaks.
unit ClassificationMatrix;
interface
uses
Generics.Collections, Generics.Defaults, SysUtils, RubTerm;
type
TClassificationMatrix = class(TObject)
private
FTable: TObjectDictionary<TRubTerm, Integer>;
public
constructor Create;
procedure AddCount(ADocsCount: Integer; ARubName, ATermName: String);
function GetCount(ARubName, ATermName: String): Integer;
end;
implementation
constructor TClassificationMatrix.Create;
var
Comparer : IEqualityComparer<RubTerm.TRubTerm>;
begin
Comparer := TRubTermComparer.Create;
FTable := TObjectDictionary<TRubTerm, Integer>.Create([doOwnsKeys],TRubTermComparer.Create);
end;
procedure TClassificationMatrix.AddCount(ADocsCount: Integer; ARubName, ATermName: String);
var
ARubTerm: TRubTerm;
begin
ARubTerm := TRubTerm.Create(ARubName, ATermName);
FTable.Add(ARubTerm, ADocsCount);
end;
function TClassificationMatrix.GetCount(ARubName, ATermName: String): Integer;
var
ARubTerm: TRubTerm;
begin
ARubTerm := TRubTerm.Create(ARubName, ATermName);
try
if Not FTable.TryGetValue(ARubTerm, Result) then
result := 0;
finally
ARubTerm.Free;
end;
end;
end.
And the RubTerm.pas unit
unit RubTerm;
interface
uses Generics.Defaults;
type
TRubTerm = Class(TObject)
private
FRubricName: String;
FTermName: String;
public
property RubricName: String read FRubricName;
property TermName: String read FTermName;
constructor Create(ARubricName, ATermName: String);
function GetHashCode: Integer; override;
end;
TRubTermComparer = class(TInterfacedObject, IEqualityComparer<TRubTerm>)
public
function Equals(const Left, Right: TRubTerm): Boolean;
function GetHashCode(const Value: TRubTerm): Integer;
end;
implementation
constructor TRubTerm.Create(ARubricName, ATermName: String);
begin
Self.FRubricName := ARubricName;
Self.FTermName := ATermName;
end;
{ TRubTermComparer }
function TRubTermComparer.Equals(const Left, Right: TRubTerm): Boolean;
begin
result := (Left.RubricName = Right.RubricName) and (Left.TermName = Right.TermName);
end;
function TRubTermComparer.GetHashCode(const Value: TRubTerm): Integer;
begin
result := Value.GetHashCode;
end;
//The Hashing code was taken from David's Answer to make this a complete answer.
{$IFOPT Q+}
{$DEFINE OverflowChecksEnabled}
{$Q-}
{$ENDIF}
function CombinedHash(const Values: array of Integer): Integer;
var
Value: Integer;
begin
Result := 17;
for Value in Values do begin
Result := Result*37 + Value;
end;
end;
{$IFDEF OverflowChecksEnabled}
{$Q+}
{$ENDIF}
function GetHashCodeString(const Value: string): Integer;
begin
Result := BobJenkinsHash(PChar(Value)^, SizeOf(Char) * Length(Value), 0);
end;
function TRubTerm.GetHashCode: Integer;
begin
Result := CombinedHash([GetHashCodeString(Value.RubricName),
GetHashCodeString(Value.TermName)]);
end;
end.
I have a Delphi generic class that exposes a function with an argument of the generic type. Inside this function, I need to pass an instance of the generic type on to another object expecting a Variant type. Similar to this:
type
IMyInterface = interface
DoStuff(Value: Variant);
end;
TMyClass<T> = class
FMyIntf: IMyInterface
procedure DoStuff(SomeValue: T);
end;
[...]
procedure MyClass<T>.DoStuff(SomeValue: T);
begin
FMyIntf.DoStuff((*convert SomeValue to Variant here*));
end;
I tried using Rtti.TValue.From(SomeValue).AsVariant. This worked for integral types, but blew up for Booleans. I don't quite see why, since normally I'd be able to assign a Boolean value to a Variant...
Is there a better way to make this conversion? I only need it to work for simple built-in types (excluding enumerations and records)
I think there is no direct way to convert generic type to variant because variant cannot hold all the possible types. You must write your specific conversion routine. E.g.:
interface
//...
type
TDemo = class
public
class function GetAsVariant<T>(const AValue: T): Variant;
end;
//...
implementation
uses
Rtti,
TypInfo;
//...
{ TDemo}
class function TDemo.GetAsVariant<T>(const AValue: T): Variant;
var
val: TValue;
bRes: Boolean;
begin
val := TValue.From<T>(AValue);
case val.Kind of
tkInteger: Result := val.AsInteger;
tkInt64: Result := val.AsInt64;
tkEnumeration:
begin
if val.TryAsType<Boolean>(bRes) then
Result := bRes
else
Result := val.AsOrdinal;
end;
tkFloat: Result := val.AsExtended;
tkString, tkChar, tkWChar, tkLString, tkWString, tkUString:
Result := val.AsString;
tkVariant: Result := val.AsVariant
else
begin
raise Exception.Create('Unsupported type');
end;
end;
end;
Because TValue.AsVariant handles most of the type conversions internally, this function can be simplified. I will handle enumerations in case you could need them later:
class function TDemo.GetAsVariant<T>(const AValue: T): Variant;
var
val: TValue;
begin
val := TValue.From<T>(AValue);
case val.Kind of
tkEnumeration:
begin
if val.TypeInfo = TypeInfo(Boolean) then
Result := val.AsBoolean
else
Result := val.AsOrdinal;
end
else
begin
Result := val.AsVariant;
end;
end;
Possible usage:
var
vValue: Variant;
begin
vValue := TDemo.GetAsVariant<Boolean>(True);
Assert(vValue = True); //now vValue is a correct Boolean
Looks like in my Delphi version 10.2 the Boolean problem is gone and TValue.From<T>(FValue).AsVariant is enough.
Here an example with some other helpful things like comparing the generic type:
TMyValue<T> = class(TPersistent)
private
FValue: T;
procedure SetValue(const AValue: T);
function GetAsVariant: Variant; override;
public
procedure Assign(Source: TPersistent); override;
property Value: T read FValue write SetValue;
property AsVariant: Variant read GetAsVariant;
end;
function TMyValue<T>.GetAsVariant: Variant;
begin
Result:= TValue.From<T>(FValue).AsVariant;
end;
procedure TMyValue<T>.SetValue(const AValue: T);
begin
if TEqualityComparer<T>.Default.Equals(AValue, FValue) then Exit;
FValue:= AValue;
//do something
end;
procedure TMyValue<T>.Assign(Source: TPersistent);
begin
if Source is TMyValue<T> then Value:= (Source as TMyValue<T>).Value
else inherited;
end;
Another way (tested XE10)
Var
old : variant;
val : TValue;
Begin
val := TValue.FromVariant(old);
End;