Jump to content

Mahdi Safsafi

Members
  • Content Count

    383
  • Joined

  • Last visited

  • Days Won

    10

Everything posted by Mahdi Safsafi

  1. Mahdi Safsafi

    Relaxed JSON

    Are you sure about that ?
  2. Mahdi Safsafi

    EmptyString constant

    For me, I found it useful in the following cases: - The Sync mode utility works great with EmptyStr. - I edit a lot of my pas files manually using Notepad, so I just select one EmptyStr and I can clearly see all places where the EmptyStr was implemented. - Last thing, it's a mind trick, I pay much more attention for arguments that use EmptyStr. Blabla(... , EmptyStr); // focus on that call. Blabla(... , ''); // usually I ignore it.
  3. Mahdi Safsafi

    How do you organize units, forms?

    Didn't know that GExperts implements such functionality. Does it sort function implementation too ?
  4. Mahdi Safsafi

    Funny Code in System.Types

    Not just the cast ... Result.X := Result.X !
  5. Mahdi Safsafi

    Funny Code in System.Types

    Wow: Result.x := SmallInt(Result.x);
  6. Hello guys, I always thought that the Delphi compiler takes the inlined function and TRIES to insert it (without making a call instruction) where the call to that function occurs. However for some circumstances it can do better ! it TRIES to evaluate the function (just like constexpr in c++) ! Here is an example : program Console1; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils; function Max(a, b: Integer): Integer; inline; begin if (a > b) then Result := a else Result := b; end; var a: Integer = 5; b: Integer = 9; i: Integer; begin Writeln('--------------------------------'); i := Max(5, 9); // evaluated Writeln(Format('max=%d', [i])); i := Max(a, b); // not evaluated Writeln(Format('max=%d', [i])); Writeln('--------------------------------'); Readln; end. After compiling the above example (x64, Release mode), the compiler generates the following code: //------------------------------------------------------ Delphi ------------------------------------------------------------ 0000000000428510 | 48:8B0D 59880000 | mov rcx,qword ptr ds:[430D70] | 0000000000428517 | 48:8D15 6E010000 | lea rdx,qword ptr ds:[42868C] | rdx:EntryPoint, 000000000042868C:L"--------------------------------" 000000000042851E | E8 2DEFFDFF | call <console1.sub_407450> | 0000000000428523 | 48:89C1 | mov rcx,rax | rax:EntryPoint 0000000000428526 | E8 85F0FDFF | call <console1.sub_4075B0> | 000000000042852B | E8 60D4FDFF | call <console1.sub_405990> | 0000000000428530 | B8 09000000 | mov eax,9 | eax:EntryPoint, 9:'\t' 0000000000428535 | 8905 3D420100 | mov dword ptr ds:[43C778],eax | eax:EntryPoint 000000000042853B | 8B05 37420100 | mov eax,dword ptr ds:[43C778] | eax:EntryPoint 0000000000428541 | 8945 28 | mov dword ptr ss:[rbp+28],eax | eax:EntryPoint 0000000000428544 | C645 30 00 | mov byte ptr ss:[rbp+30],0 | 0000000000428548 | 48:8D4D 38 | lea rcx,qword ptr ss:[rbp+38] | 000000000042854C | 48:8D15 89010000 | lea rdx,qword ptr ds:[<sub_4286DC>] | rdx:EntryPoint, 00000000004286DC:L"max=%d" 0000000000428553 | 4C:8D45 28 | lea r8,qword ptr ss:[rbp+28] | 0000000000428557 | 4D:33C9 | xor r9,r9 | r9:EntryPoint 000000000042855A | E8 C16AFFFF | call <console1.sub_41F020> | 000000000042855F | 48:8B0D 0A880000 | mov rcx,qword ptr ds:[430D70] | 0000000000428566 | 48:8B55 38 | mov rdx,qword ptr ss:[rbp+38] | rdx:EntryPoint 000000000042856A | E8 E1EEFDFF | call <console1.sub_407450> | 000000000042856F | 48:89C1 | mov rcx,rax | rax:EntryPoint 0000000000428572 | E8 39F0FDFF | call <console1.sub_4075B0> | 0000000000428577 | E8 14D4FDFF | call <console1.sub_405990> | 000000000042857C | 8B05 72860000 | mov eax,dword ptr ds:[430BF4] | eax:EntryPoint 0000000000428582 | 3B05 70860000 | cmp eax,dword ptr ds:[430BF8] | eax:EntryPoint 0000000000428588 | 7E 08 | jle console1.428592 | 000000000042858A | 8B05 64860000 | mov eax,dword ptr ds:[430BF4] | eax:EntryPoint 0000000000428590 | EB 06 | jmp console1.428598 | 0000000000428592 | 8B05 60860000 | mov eax,dword ptr ds:[430BF8] | eax:EntryPoint 0000000000428598 | 8905 DA410100 | mov dword ptr ds:[43C778],eax | eax:EntryPoint 000000000042859E | 8B05 D4410100 | mov eax,dword ptr ds:[43C778] | eax:EntryPoint 00000000004285A4 | 8945 28 | mov dword ptr ss:[rbp+28],eax | eax:EntryPoint 00000000004285A7 | C645 30 00 | mov byte ptr ss:[rbp+30],0 | 00000000004285AB | 48:8D4D 20 | lea rcx,qword ptr ss:[rbp+20] | 00000000004285AF | 48:8D15 26010000 | lea rdx,qword ptr ds:[<sub_4286DC>] | rdx:EntryPoint, 00000000004286DC:L"max=%d" 00000000004285B6 | 4C:8D45 28 | lea r8,qword ptr ss:[rbp+28] | 00000000004285BA | 4D:33C9 | xor r9,r9 | r9:EntryPoint 00000000004285BD | E8 5E6AFFFF | call <console1.sub_41F020> | 00000000004285C2 | 48:8B0D A7870000 | mov rcx,qword ptr ds:[430D70] | 00000000004285C9 | 48:8B55 20 | mov rdx,qword ptr ss:[rbp+20] | rdx:EntryPoint 00000000004285CD | E8 7EEEFDFF | call <console1.sub_407450> | 00000000004285D2 | 48:89C1 | mov rcx,rax | rax:EntryPoint 00000000004285D5 | E8 D6EFFDFF | call <console1.sub_4075B0> | 00000000004285DA | E8 B1D3FDFF | call <console1.sub_405990> | 00000000004285DF | 48:8B0D 8A870000 | mov rcx,qword ptr ds:[430D70] | 00000000004285E6 | 48:8D15 9F000000 | lea rdx,qword ptr ds:[42868C] | rdx:EntryPoint, 000000000042868C:L"--------------------------------" 00000000004285ED | E8 5EEEFDFF | call <console1.sub_407450> | 00000000004285F2 | 48:89C1 | mov rcx,rax | rax:EntryPoint 00000000004285F5 | E8 B6EFFDFF | call <console1.sub_4075B0> | 00000000004285FA | E8 91D3FDFF | call <console1.sub_405990> | 00000000004285FF | 48:8B0D 9A880000 | mov rcx,qword ptr ds:[430EA0] | 0000000000428606 | E8 45E6FDFF | call <console1.sub_406C50> | 000000000042860B | E8 80D3FDFF | call <console1.sub_405990> | 0000000000428610 | 90 | nop | You can see that the compiler was able to evaluate the first expression "i := Max(5, 9);" and just generated one single instruction "mov eax, 9". For the second call "i := Max(a, b);" the compiler didn't make any evaluation and it just inlined the function. This is really impressive ! the first call was completely evaluated at the compiling time. I also tested the above example with MSVC and the result was quite different (I was expecting that before running my debugger): #include "pch.h" #include <iostream> inline int max(int a, int b) { return a > b ? a : b; } constexpr int max2(int a, int b) { return a > b ? a : b; } int a = 5; int b = 9; int i; int main() { printf("--------------------------------\n"); i = max(5, 9); // evaluated printf("max=%d\n", i); i = max(a, b); // evaluated printf("max=%d\n", i); i = max2(5, 9); // evaluated printf("max=%d\n", i); i = max2(a, b); // evaluated printf("max=%d\n", i); printf("--------------------------------\n"); } //------------------------------------------------------ CPP ------------------------------------------------------------ 00007FF7DB431070 | 48:83EC 28 | sub rsp,28 | consoleapplication4.cpp:19 00007FF7DB431074 | 48:8D0D 85110000 | lea rcx,qword ptr ds:[7FF7DB432200] | consoleapplication4.cpp:20, 00007FF7DB432200:"--------------------------------\n" 00007FF7DB43107B | E8 90FFFFFF | call <consoleapplication4.printf> | 00007FF7DB431080 | BA 09000000 | mov edx,9 | consoleapplication4.cpp:24, 9:'\t' 00007FF7DB431085 | C705 91250000 09000000 | mov dword ptr ds:[<i>],9 | 9:'\t' 00007FF7DB43108F | 48:8D0D 92110000 | lea rcx,qword ptr ds:[7FF7DB432228] | 00007FF7DB432228:"max=%d\n" 00007FF7DB431096 | E8 75FFFFFF | call <consoleapplication4.printf> | 00007FF7DB43109B | BA 09000000 | mov edx,9 | consoleapplication4.cpp:26, 9:'\t' 00007FF7DB4310A0 | C705 76250000 09000000 | mov dword ptr ds:[<i>],9 | 9:'\t' 00007FF7DB4310AA | 48:8D0D 77110000 | lea rcx,qword ptr ds:[7FF7DB432228] | 00007FF7DB432228:"max=%d\n" 00007FF7DB4310B1 | E8 5AFFFFFF | call <consoleapplication4.printf> | 00007FF7DB4310B6 | BA 09000000 | mov edx,9 | consoleapplication4.cpp:28, 9:'\t' 00007FF7DB4310BB | C705 5B250000 09000000 | mov dword ptr ds:[<i>],9 | 9:'\t' 00007FF7DB4310C5 | 48:8D0D 5C110000 | lea rcx,qword ptr ds:[7FF7DB432228] | 00007FF7DB432228:"max=%d\n" 00007FF7DB4310CC | E8 3FFFFFFF | call <consoleapplication4.printf> | 00007FF7DB4310D1 | BA 09000000 | mov edx,9 | consoleapplication4.cpp:30, 9:'\t' 00007FF7DB4310D6 | C705 40250000 09000000 | mov dword ptr ds:[<i>],9 | 9:'\t' 00007FF7DB4310E0 | 48:8D0D 41110000 | lea rcx,qword ptr ds:[7FF7DB432228] | 00007FF7DB432228:"max=%d\n" 00007FF7DB4310E7 | E8 24FFFFFF | call <consoleapplication4.printf> | 00007FF7DB4310EC | 48:8D0D 0D110000 | lea rcx,qword ptr ds:[7FF7DB432200] | consoleapplication4.cpp:31, 00007FF7DB432200:"--------------------------------\n" 00007FF7DB4310F3 | E8 18FFFFFF | call <consoleapplication4.printf> | 00007FF7DB4310F8 | 33C0 | xor eax,eax | consoleapplication4.cpp:32 00007FF7DB4310FA | 48:83C4 28 | add rsp,28 | 00007FF7DB4310FE | C3 | ret | Note that MSVC also generated a very short routine compared to what Delphi generated!
  7. Mahdi Safsafi

    Delphi inline and function evaluation

    of course ! But you know : the MSVC's output didn't impressed me since I was expecting to get such result(especially with the constexpr specifier). However, Delphi did ! I never thought that it can do function evaluation on the fly.
  8. Hello guys, I started this thread with hope to get advises and feedback. I have a large complex data (splitted into fields and many of those fields share common properties) that must be saved on files. XML was the best choice but since I need to edit those files manually … it’s out of question to use XML (it just not user friendly). Neither YAML was(I’m not a big fun of languages that use space and tab) ! So I found my self using JSON. But I got many issues : my files got very big(because there is no reference/template support) and not mentioning that I was desperately lacking for comments. So I decided to write a custom language that inherits all JSON spec and provides additional supports for reference and templates. Here is an example : # templates: # --------- class TPerson<Name, Sex>{ name: Name, sex : Sex, } class TMan<Name> : TPerson<Name, "male">; class TWoman<Name>: TPerson<Name, "female">; class TChild<Name, Sex, Father, Mother> : TPerson<Name, Sex>{ father: Father, mother: Mother, } class TBoy<Name, Father, Mother> : TChild<Name, "male", Father, Mother>; class TGirl<Name, Father, Mother> : TChild<Name, "female", Father, Mother>; class TFamily<Name, Father, Mother, Childs>{ name : Name, father: Father, mother: Mother, childs: Childs, } # references: # ---------- def mike : TMan<"mike">; def mira : TWoman<"mira">; def jaky : TBoy<"jaky", mike, mira>; def lila : TGirl<"lila", mike, mira>; # public (just like json): [TFamily<"FamilyName", mike, mira, [jaky, lila]>] After my language runs the above example, actually it’s able to generate a Perl object that supports reference so if I change the father name of the first child in run-time … the father’s name will change for all fields: my $file = 'test.xjson'; my $parser = XJSON::Parser->new(); my $xjson = $parser->parse($file); $xjson->[0]->{childs}->[0]->{father}->{name} = "NotMike"; # mike's name changed for all fields. And converting it to JSON will dump the following: [ { "name" : "FamilyName", "father" : { "name" : "mike", "sex" : "male" }, "childs" : [ { "name" : "jaky", "sex" : "male", "mother" : { "sex" : "female", "name" : "mira" }, "father" : { "name" : "mike", "sex" : "male" } }, { "name" : "lila", "sex" : "female", "father" : { "name" : "mike", "sex" : "male" }, "mother" : { "sex" : "female", "name" : "mira" } } ], "mother" : { "sex" : "female", "name" : "mira" } } ] Right now, my language is draft and many things are implemented in a no proper way. I may rewrite it in C and consume it from Perl and probably Pascal. So what do you think guys about the language ? and any idea about improving it ? and if you were at my situation what kind of solution you may think to use ?
  9. Mahdi Safsafi

    Discussion: JSON and templates

    Yeah that's good too ! and maybe I can use function just like template too.
  10. Mahdi Safsafi

    Discussion: JSON and templates

    Child or Children that is not the question !
  11. Glad to see that my explanation was helpful.
  12. I think that the syntax was always there and I use it a lot. I found it more useful especially it provides a compiler check about the indexing type. This code : NodeNames: array [TInfoType] of string = ('itProject', 'itContacts', 'itWorker', 'itWorkers'); Is exactly equivalent to this one : NodeNames2: array [Ord(Low(TInfoType)) .. Ord(High(TInfoType))] of string = ('itProject', 'itContacts', 'itWorker', 'itWorkers'); Note that you can also use range: NodeNames3: array [itContacts .. itWorkers] of string = ('itContacts', 'itWorker','itWorkers');
  13. Mahdi Safsafi

    ImmersiveColors v2

    Hello guys, Here is the v2 of my ImmersiveColors project: Added FPC and lazarus support. Replaced TImmersiveColors class with a simplified functions: GetImmersiveColorSetCount, GetImmersiveColor, GetActiveImmersiveColor, ... Added default return value to make the library work on platform that do not have immersive colors support (XP, Win7, macOS, ...). Added many new function such as IsDarkThemeActive, GetRivalColorType,... Added three new components : TImmersiveColorsListBox, TImmersiveColorSetListBox, TImmersiveNotify. Improved Explorer. You can find the v2 on the "next" branch : https://github.com/MahdiSafsafi/ImmersiveColors/tree/next
  14. I believe there is no way without RTTI. The only things you can do is to recompile your code with a version of Delphi that has RTTI support. Or you might need to write a simple script that generates a unique GUID table and then using regular-expression you can find all your defined GUID and replace them with the new one.
  15. Mahdi Safsafi

    Blogged : Delphi Package Manager RFC

    Please reconsider this point ! Nowadays it's really important to use scripts (we're no longer on 19xx). Also for the package name, it's important to have a formal rule for name. e.g a package's name may look like this : TMS::VCL::SomeProduct. Also we can group names by category (like cpan packages which I really like its concept) e.g: XML::MyXmlLib. So all XML stuffs are under XML::.
  16. That's because Unicode code-points are organised in ranges. Meaning, for a given code-point, if you can know its range, you can get its category without implementing a full 0xFFFF table. I don't know what algorithm Delphi uses (I'm not in a mood to debug the System.Character unit). The good news, I wrote a simple demonstration that do what the InternalGetUnicodeCategory does. The principle is to regroup all similar category and then do a binary filtering. I assumed that my Unicode code-points lies from 0x0000 to 0xFFFF. First I grouped them by ranges and then I did a binary indexing and finally I setup my table. My final table size is 19200 bytes rather than ‭65535 bytes! program Console2; {$APPTYPE CONSOLE} {$R *.res} uses System.SysUtils, System.TypInfo, System.Classes, System.Character; type TRange = record Min: Integer; Max: Integer; Category: Integer; Mask: Integer; public procedure Increase(Value: Integer); procedure Compute(); inline; class function Create(AMin, AMax: Integer): TRange; static; end; PRange = ^TRange; var CatIndexPrimary: array [0 .. $FF] of SmallInt; CatIndexSecondary: array [0 .. $FF] of SmallInt; Table: array of ShortInt; const MAX_CODEPOINT = $FFFF; function MyGetUnicodeCategory(C: UCS4Char): TUnicodeCategory; begin // similar to InternalGetUnicodeCategory. Result := TUnicodeCategory( Table[CatIndexPrimary[C shr 8] + CatIndexSecondary[C and $FF]]); end; function GetPrimaryKey(Value: Integer): Integer; inline; begin Result := Value shr $08; end; function GetSecondaryKey(Value: Integer): Integer; inline; begin Result := Value and $FF; end; function GetUnicodeCategoryName(Value: TUnicodeCategory): string; begin Result := GetEnumName(TypeInfo(TUnicodeCategory), Integer(Value)); end; procedure BuildTable(); var i, k, j, p, s, index: Integer; Category: TUnicodeCategory; List: TList; Range: PRange; SeenList: TList; size: Integer; LTable: array [0 .. MAX_CODEPOINT] of ShortInt; LCatIndexPrimary: array [0 .. $FF] of Integer; LCatIndexSecondary: array [0 .. $FF] of Integer; CategoryValue, PreviousCategoryValue: Integer; begin { initialization } List := TList.Create(); SeenList := TList.Create(); PreviousCategoryValue := -1; Range := nil; size := 0; for i := 0 to $FF do begin LCatIndexPrimary[i] := 0; LCatIndexSecondary[i] := 0; end; { build codepoint ranges } for i := 0 to MAX_CODEPOINT do begin LTable[i] := -1; Category := GetUnicodeCategory(i); CategoryValue := Integer(Category); if (PreviousCategoryValue <> CategoryValue) then begin PreviousCategoryValue := CategoryValue; Range := PRange(GetMemory(sizeof(TRange))); Range^ := TRange.Create(i, i); Range^.Category := CategoryValue; List.Add(Range); end else begin // continued range. Range^.Increase(1); end; end; { // debug ranges for i := 0 to List.Count - 1 do begin Range := List[i]; Writeln(Format('category=%s range[%d..%d] mask=0x%x', [GetUnicodeCategoryName(TUnicodeCategory(Range^.Category)), Range^.Min, Range^.Max, Range^.Max])); end; } { setup a uniq mask for LCatIndexPrimary and LCatIndexSecondary } for i := 0 to List.Count - 1 do begin Range := List[i]; for j := Range^.Min to Range^.Max do begin p := GetPrimaryKey(j); s := GetSecondaryKey(j); LCatIndexPrimary[p] := LCatIndexPrimary[p] or Range^.Mask or Range^.Category; LCatIndexSecondary[s] := s; end; end; { normalize masks to indexes } for i := 0 to $FF do begin k := SeenList.IndexOf(Pointer(LCatIndexPrimary[i])); if (k = -1) then begin k := SeenList.Count; SeenList.Add(Pointer(LCatIndexPrimary[i])); end; LCatIndexPrimary[i] := k shl 8; end; { fill table } for i := 0 to List.Count - 1 do begin Range := List[i]; for j := Range^.Min to Range^.Max do begin p := GetPrimaryKey(j); s := GetSecondaryKey(j); index := LCatIndexPrimary[p] + LCatIndexSecondary[s]; Assert((LTable[index] = -1) or (LTable[index] = Range^.Category)); LTable[index] := Range^.Category; end; end; { clone all L* tables } for i := 0 to MAX_CODEPOINT do begin if (LTable[i] <> -1) then Inc(size); end; SetLength(Table, size); for i := 0 to size - 1 do Table[i] := LTable[i]; for i := 0 to $FF do begin Assert((LCatIndexPrimary[i] >= Low(SmallInt)) and (LCatIndexPrimary[i] <= High(SmallInt))); Assert((LCatIndexSecondary[i] >= Low(SmallInt)) and (LCatIndexSecondary[i] <= High(SmallInt))); CatIndexPrimary[i] := LCatIndexPrimary[i]; CatIndexSecondary[i] := LCatIndexSecondary[i]; end; { output results } Writeln('---------------------------------'); Writeln(Format('size of table = %d bytes', [Length(Table) * sizeof(ShortInt)])); Writeln(Format('size of CatIndexPrimary = %d bytes', [sizeof(CatIndexPrimary)])); Writeln(Format('size of CatIndexSecondary = %d bytes', [sizeof(CatIndexSecondary)])); size := (Length(Table) * sizeof(ShortInt)) + sizeof(CatIndexPrimary) + sizeof(CatIndexSecondary); Writeln(Format('total size = %d bytes (rather than %d) => we won %d bytes !', [size, $FFFF, $FFFF - size])); { clean-up } for i := 0 to List.Count - 1 do begin Range := List[i]; FreeMem(Range); end; List.Free(); SeenList.Free(); end; { TRange } procedure TRange.Compute(); var i: Integer; begin for i := Min to Max do Mask := Mask and i; end; class function TRange.Create(AMin, AMax: Integer): TRange; begin Result.Mask := -1; Result.Min := AMin; Result.Max := AMax; Result.Compute(); end; procedure TRange.Increase(Value: Integer); begin Inc(Max, Value); Compute(); end; var i: Integer; Category, Category2: TUnicodeCategory; begin ReportMemoryLeaksOnShutdown := True; BuildTable(); { tests } for i := 0 to MAX_CODEPOINT do begin Category := MyGetUnicodeCategory(i); Category2 := GetUnicodeCategory(i); Assert(Category = Category2); end; Readln; end. NB: I ignored all optimisation/memory good practices. You might need to optimise the code yourself.
  17. You made a beautiful plugin and I really hope that YOU'll continue developing it.
  18. I believe that you didn't understand me clearly. My answer wasn't about whether is pointless or not ! my answer was about the coding style (and I gave an example about the Win32 api). Suppose I made a library that have a record like this : type TDummy = record // ... public function Create(): TDummy; procedure Free(); end; { TDummy } function TDummy.Create: TDummy; begin // FOR NOW ... do nothing here ! end; procedure TDummy.Free; begin // on this platform do nothing for now ! // feature platform do something. end; Currently Create and Free do nothing on Win32(x86). Yep there is no need to use them. But I use them just for future compatibility. Now after 1 year, I decided to port my library to let say WinRT or MIPS. Now my Free must do something here (really)! Now, from your approach, you must track all variables and free them if you want your code to run successfully on WinRT, MIPS. For me, because I used them on all configurations, I wan't going to track them ! Also, is there any guaranties that "FContextToken" won't change to something else on future ?
  19. You read my explanation. From now, you' ve no excuses to use it without freeing it 😉 I'm watching you.
  20. I saw many people using TRTTIContext without freeing it. That's wrong ! The Free function wasn't there for nothing. I just check it and found that it assigns a nil to interface ! procedure TRttiContext.Free; begin FContextToken := nil; end; You should always use Free when a record implements it even if it does nothing !!! It might do nothing currently ... but maybe the developer introduce it to use it later or it does something on other configuration (ARM ?)! As an example, from the Win32 api FlushInstructionCache function does nothing on x86 but it's important on ARM ! My bad ... Sorry. You're missing "@" ! Writeln(' '+lFields.Name + ': '+lFields.GetValue(TypeInfo(@Rec)).AsString); I just played a little with the above code : uses System.SysUtils, System.Rtti, System.TypInfo, System.Generics.Collections; type TRecord1 = record private var FTypeInfo: Pointer; // this must be the first field and all record must implement it. public var FField1: Integer; // Record fields. class function Create: TRecord1; static; end; TRecord2 = record private var FTypeInfo: Pointer; public var FField1: Integer; FField2: string; FField3: Boolean; class function Create: TRecord2; static; end; procedure DoSomething(const Rec); type TRecordHack = record FTypeInfo: Pointer; // since FTypeInfo is the first field in all records, we can hack it ! end; PRecordHack = ^TRecordHack; var PHack: PRecordHack; LTypeInfo: Pointer; LCntx: TRttiContext; LType: TRttiType; LField: TRttiField; LValue: TValue; LKind: TTypeKind; SValue: string; begin PHack := PRecordHack(@Rec); LTypeInfo := PHack^.FTypeInfo; // RTTI: LCntx := TRttiContext.Create(); try LType := LCntx.GetType(LTypeInfo); Writeln(Format('record (%s):', [LType.Name])); for LField in LType.GetFields do begin if (LField.Visibility = mvPrivate) then // skip private (FTypeInfo). Continue; LValue := LField.GetValue(@Rec); LKind := LValue.Kind; case LKind of tkInteger: SValue := IntToStr(LValue.AsInteger); tkString, tkUString: SValue := LValue.AsString; tkEnumeration: SValue := GetEnumName(LValue.TypeInfo, TValueData(LValue).FAsSLong); else SValue := '??'; end; Writeln(Format(' field (%s) = %s', [LField.Name, SValue])); end; finally LCntx.Free(); end; end; { TRecord1 } class function TRecord1.Create: TRecord1; begin Result.FTypeInfo := TypeInfo(TRecord1); end; { TRecord2 } class function TRecord2.Create: TRecord2; begin Result.FTypeInfo := TypeInfo(TRecord2); end; var a: TRecord1; b: TRecord2; begin a := TRecord1.Create(); a.FField1 := 1; DoSomething(a); b := TRecord2.Create(); b.FField1 := -10; b.FField2 := 'foo'; DoSomething(b); Readln; end.
  21. What about that : type TRecord1 = record private var FTypeInfo: Pointer; // this must be the first field and all record must implement it. public var FField1: Integer; // Record fields. class function Create: TRecord1; static; end; TRecord2 = record private var FTypeInfo: Pointer; public var FField1: Integer; FField2: string; class function Create: TRecord2; static; end; procedure DoSomething(const Rec); type TRecordHack = record FTypeInfo: Pointer; // since FTypeInfo is the first field in all records, we can hack it ! end; PRecordHack = ^TRecordHack; var PHack: PRecordHack; TypeInfo: Pointer; LCntx: TRttiContext; LType: TRttiType; begin PHack := PRecordHack(@Rec); TypeInfo := PHack^.FTypeInfo; // RTTI: LCntx := TRttiContext.Create(); try LType := LCntx.GetType(TypeInfo); ShowMessage(LType.Name); finally LCntx.Free(); end; end; procedure TForm1.Button1Click(Sender: TObject); var a: TRecord1; b: TRecord2; begin a := TRecord1.Create(); DoSomething(a); b := TRecord2.Create(); DoSomething(b); end; { TRecord1 } class function TRecord1.Create: TRecord1; begin Result.FTypeInfo := TypeInfo(TRecord1); end; { TRecord2 } class function TRecord2.Create: TRecord2; begin Result.FTypeInfo := TypeInfo(TRecord2); end;
  22. Mahdi Safsafi

    Complete Boolean Evaluation

    Oh I didn't notice that (I thought that long-circuit is a part of Delphi and not the ISO).
  23. Mahdi Safsafi

    Complete Boolean Evaluation

    I believe that complete expression evaluation was made for lazy people ! The only useful scenario is that your condition contains a function call that must run on all situations. Otherwise it's just useless: Result := Variable and (Variable2 = 5) and Variable3; // completely useless ! additional CPU-time for nothing ! Result := Variable and OtherWork(); // maybe useful. It's important to mention that many programming language do not support full expression evaluation and some of them provide logical operators (such && and ||) and name long-circuit (complete expression evaluation) as a flow control (they use 'and', 'or' keyword). Here is an example: exists($filename) and doWork() or error("Could not open file filename"); // parsed as (exists($filename) and doWork()) or error("Could not open file filename"); exists($filename) and doWork() || error("Could not open file filename"); // parsed as exists($filename) and (doWork() || error("Could not open file filename"));
  24. Mahdi Safsafi

    How to switch condition position?

    No one will switch to complete circuit evaluation. There is a rare case when it makes sense to use it. function DoSomething(): Boolean; begin // ... Result := (not HasError) and DumpStatus(); end; DumpStatus is a function that will dump the status whether there was an error or not. If error exists, DumpStatus will dump the error status. If not it will dump a success status. DoSomething's result depends on HasError. So it's important to do a full evaluation of the expression "(not HasError) and DumpStatus()".
  25. Mahdi Safsafi

    How to switch condition position?

    Don't worry everything is gonna be alright by the time. When I was beginner I asked a similar question : what's the purpose of interface. I got many answers but it took me a lot of time to understand what they were saying. Here is a free advice : first get familiar about the basic of program's life from the loader-time to the cpu-time (just get the basic things) and then master the fundamental stuff of Delphi (also just learn the basic things : statements, functions, array, records, RTL, ...). Now join the open source community and share your first library/app, fork other project and analyse people coding styles (it will be a great experience to you as was mine). after that you will find yourself understanding things quickly even you can master new language with just few days. Good Luck.
×