Jump to content

Mahdi Safsafi

Members
  • Content Count

    22
  • Joined

  • Last visited

Community Reputation

8 Neutral

About Mahdi Safsafi

  • Birthday 02/12/1993

Technical Information

  • Delphi-Version
    Delphi Community Edition

Recent Profile Visitors

The recent visitors block is disabled and is not being shown to other users.

  1. 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.
  2. 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::.
  3. 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.
  4. You made a beautiful plugin and I really hope that YOU'll continue developing it.
  5. 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 ?
  6. You read my explanation. From now, you' ve no excuses to use it without freeing it 😉 I'm watching you.
  7. 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.
  8. 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;
  9. 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).
  10. 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"));
  11. 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()".
  12. 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.
  13. Mahdi Safsafi

    How to switch condition position?

    Well Mike. This is our community. They're all exited and each topic turns just like this one xD ... All people here love coding ... and I'm sure you will love this community too. You said your're a new to Delphi. We welcome you here 🙂. Now for your question about using "Result := Value if(Condition);" , the sort answer is not possible. I believe that using table lookup is match easy for you: type TRec = record Patterns: array of string; Result: string; end; PRec = ^TRec; const Table: array [0 .. 1] of TRec = ( (Patterns: ['Prop1', 'Prop2', 'Prop3', 'Prop4', 'Prop5', 'Prop6', 'Prop7']; Result: 'N'), (Patterns: ['PropertyA', 'PropertyB', 'PropertyC', 'PropertyD']; Result: 'DefaultABC') ); function LookUp(const AProperty: string): string; var I: Integer; Rec: PRec; begin for I := 0 to Length(Table) - 1 do begin Rec := @Table[I]; if (MatchStr(AProperty, Rec^.Patterns)) then exit(Rec^.Result); end; Result := 'Default'; end; Because you're a new to Delphi, I believe that's the best way for you right now. Later you can optimise it by using binary string search, hash-code, magic-index, crc32 and binary lookup, ...
  14. Mahdi Safsafi

    How to switch condition position?

    Ah I see ! If I know that the compiler can do a good job about optimisation I'd write something like this: begin // ... // Requires Rio const table = [Result, 'true']; Result := table[integer(Condition)]; end; desperately waiting for : Result := Condition ? Value : Result;
  15. Mahdi Safsafi

    How to switch condition position?

    You might consider to inline it ... the call is too expensive ! Also what about that ? Result := Condition or Result;
×