Converting TStack code from Delphi to Lazarus - delphi

In Delphi I have the following code, and all works well:
var
StackOptions:TStack<String>;
s:string;
bfisio:boolean;
begin
StackOptions:=TStack<String>.Create;
//some pushs here
for s in StackOptions do begin
dosomething;
end;
end;
In Lazarus I can do this:
uses
..., gstack;
type
TStringStack = specialize TStack<String>;
var
StackOptions: TStringStack;
s:string;
begin
//But this code doesn;t compile
StackOptions := TStringStack.Create;
//some pushs here
for s in StackOptions do begin // <-- Error
dosomething;
end;
end;
I get the next error in Lazarus:
Compile Project, Target: TicketLaz.exe: Exit code 1, Errors: 1
umain.pas(263,12) Error: Cannot find an enumerator for the type "TStack$1$crcAC3AF268"
How could I loop the Stack and search for a value with Lazarus without removing items from Stack?

FPC's stack is backed by a TVector.
The TVector has an enumerator.
You can easily add a class helper like so:
Quick and dirty code.
type
TStringStack = specialize TStack<String>;
type
{ TStackHelper }
TVectorEnumerator = specialize TVector<string>.TVectorEnumerator;
TStackHelper = class helper for TStringStack
function GetEnumerator: TVectorEnumerator;
end;
{ TStackHelper }
function TStackHelper.GetEnumerator: TVectorEnumerator;
begin
Result:= FData.GetEnumerator;
end;
I really don't see why a stack is not supposed to have an iterator.
Even in assembly you can simply do mov reg,[esp-04].
This puritanical approach to data-structures helps no-one
All this is complicated by the fact that TStack is generic.
I know FPC allows generic class helpers, but I'm not sure how to make the solution work for all TStack<T>
Another approach would be to simply edit gstack.pas to expose the iterator.

Related

Delphi closure and "old style" object type

Working with anonymous functions I found out that sometimes the compiler throws the following error:
E2555 Cannot capture symbol 'Self' when I try to use some field of the object.
I also noticed that this error seems to be related to the fact that a type, the method belongs to, is declared with "object" key word:
MyType = object()
field: integer;
...
end;
MyType.Method1()
begin
p := procedure
begin
// do something with field
end;
end;
However when a type is declared with "class" keyword it seems it works fine.
I know that to prevent the compiler error I can make a local copy of needed fields and use them inside the anonymous functions, but just to be sure - is "object" type cause of the compiler error and what's the reason of that?
Thanks in advance
As David properly analyzed it is because Self in your case is a value and not a reference. It cannot be moved to the internally created class - same is the case with any method arguments that are records. They also cannot be captured for the very same reason.
For arguments I usually copy them to a local variable which is being captured.
The same can be done for capturing Self in a record or object.
However if you capture it as value you get a copy and calling the closure later might have the "wrong" state because it captured a copy. To make it work similar you would have to capture a reference to Self but then for a value type you cannot guarantee that this reference is still valid when you call the closure.
You can see this in the following code:
program Project1;
{$APPTYPE CONSOLE}
uses
SysUtils;
type
TProc = reference to procedure;
PRecord = ^TRecord;
TRecord = object
y: Integer;
procedure Foo;
function GetProc: TProc;
end;
procedure TRecord.Foo;
begin
Writeln(y);
end;
function TRecord.GetProc: TProc;
var
this: PRecord;
begin
this := #Self;
Result :=
procedure
begin
this.Foo;
end;
end;
procedure Nested(var p: TProc);
var
r: TRecord;
begin
p := r.GetProc();
r.y := 0;
p();
r.y := 32;
p();
end;
procedure Main;
var
p: TProc;
begin
Nested(p);
p(); // <- wrong value because PRecord not valid anymore
end;
begin
Main;
end.
If you would capture TRecord it would do a local copy that it captures - you can see that it then will print 0 all the time.
Since Turbo Pascal object is long deprecated, it is reasonable for new language features not to have support for object.
There's not really any need to look much further. Since you are maintaining legacy code, I would not expect you to be introducing new language features like anonymous methods. Once you start introducing such language features, this no longer feels like legacy code maintenance and it would be reasonable to re-factor the code away from the legacy language features like object.
Having said that, I do note that the same restriction to capture applies in methods of advanced records.
type
TProc = reference to procedure;
TRecord = record
procedure Foo;
end;
procedure TRecord.Foo;
var
P: TProc;
begin
P :=
procedure
begin
Foo;
end;
end;
This fails to compile with error:
E2555 Cannot capture symbol 'Self'
Why does this code fail, even though advanced records are a fully supported modern feature?
I don't have an explanation for that and the documentation does not make it clear. A plausible explanation is that records are value types. When a local variable is captured, it is hoisted from being a stack allocated variable to a variable owned by an internally created class. That's possible for Self when Self is a reference to an instance of a class. But when Self is a value like a record, it is too late to hoist the record.
Or perhaps it is much more prosaic. Maybe the designers just implemented the most important use case (capturing Self for a class) and omitted the less widely used cases for expediency. It is frustrating that the documentation does not appear to give any rules for what can and cannot be captured.

Can I use interfaces without invoking hidden try-finally's

I want to refactor DelphiAST to use interfaces to deal with different types, rather than the clunky
TDirectionary it uses now.
Some research shows that 70%+ of the running time is spend in the dictionary.
So I'll make interfaces like:
TSyntaxNode = class
...
end;
IIdentifier = interface
['{D72E945D-E397-4E02-B702-8AE6C235F9C6}']
function GetIdentifier: string;
property Identifier: string read GetIdentifier;
end;
IMethod = interface(Identifier)
['{8E6119DC-E0F3-42BD-A5BF-FB658E34499E}']
.....
end;
TMethodNode = class(TSyntaxNode, IMethod, IIdentifier,...)
...
end;
The problem according to Roman is:
Reference counting may cause performance issues. DelphiAST creates thousands of classes to produce the syntax tree (more than 100,000 of TSyntaxNode instances, when input file is big enough). How many times the reference counter would be called?
Every time that happens a hidden try finally is invoked and that will slow things way down.
Strict use of const in method params prevents the refcount code calling the method, but afaik it still happens every time you do something like, say, MyRef = List[0] - it will increment the refcount assigning to MyRef, even though the item is still present in the list.
How can I work with interfaces whilst not having to worry about refcounting and try-finally blocks?
I'm perfectly happy to manage destruction of classes manually.
Further info
I'm guessing I need to use TAggregatedObject as a base ancestor.
And I read somewhere that not assigning a GUID inhibits reference counting, but have to source to back that up.
However losing the GUID's would lead to problems in obtaining sub-interfaces so I'd have to devise a solution to that....
Can I use interfaces without invoking hidden try-finally's?
No. The compiler emits reference counting code with interfaces no matter what. You cannot avoid it.
You can implement you own version of interfaces using a record of function pointers. It will be more clunky but will avoid heap allocation and reference counting.
"Thousands of objects" always gives me a shiver. There is a significant overhead to an object in memory. You forget about it, but it pops up again when you're trying to manage thousands, or notice you loose performance on it, or start to try writing or reading from file...
Using interfaces won't change much as far as I can tell, since you still use objects (class instances) underneath.
Endeavours of this magnitude require specific use of good-old straight-to-memory data-structures. For example I've been playing with an AST stored in an array of records: https://github.com/stijnsanders/strato
Yes No you cancannot use interfaces without invoking try-finally's and refcounting.
You can however greatly reduce the number of hidden exception handlers.
You just have to be really careful to do two things.
Always use const parameters when passing interfaces.
Never store the interface in an interface type variable, but use a homebrew record to encapsulate the interface so that its refcount will not be touched.
Here's a sample of the encapsulating record:
type
TInterface<Intf: IInterface> = record
private
P: Pointer;
public
function I: Intf; inline;
class operator Implicit(const A: Intf): TInterface<Intf>; inline;
end;
function TInterface<Intf>.I: Intf;
begin
pointer(IInterface(Result)):= P;
end;
class operator TInterface<Intf>.Implicit(const A: Intf): TInterface<Intf>;
begin
Result.P:= pointer(IInterface(A));
end;
Here's a sample program to demonstrate the concept.
program Project32;
{$APPTYPE CONSOLE}
{$R *.res}
uses
System.SysUtils;
type
TInterface<Intf: IInterface> = record
private
P: Pointer;
public
function I: Intf; inline;
class operator Implicit(const A: Intf): TInterface<Intf>; inline;
end;
ITest1 = interface
function Test1: integer;
end;
ITest2 = interface
function Test2: integer;
end;
TTest = class(TAggregatedObject, ITest1, ITest2)
function Test1: integer;
function Test2: integer;
end;
{ TTest }
function TTest.Test1: integer;
begin
Result:= 1;
end;
function TTest.Test2: integer;
begin
Result:= 2;
end;
{ TInterface<Intf> }
function TInterface<Intf>.I: Intf;
begin
pointer(IInterface(Result)):= P;
end;
class operator TInterface<Intf>.Implicit(const A: Intf): TInterface<Intf>;
begin
Result.P:= pointer(IInterface(A));
end;
var
I1: TInterface<ITest1>;
I2: TInterface<ITest2>;
Test: TTest;
begin
Test:= TTest.Create(nil); //Force AV on _AddRef, _Release
If (Test.Test1 = 1) then WriteLn(S);
I1:= Test;
If (I1.I.Test1 =1) then WriteLn(S);
I2:= Test;
If (I2.I.Test2 = 2) then WriteLn(S);
ReadLn(s);
Test.Free;
end.
The TAggregatedObject does not have a interface to handle the _AddRef/_Release calls.
During the lifetime of the program, no problems will occur, however Delphi does wrap the creation of TTest in a try-finally which will generate an exception when exiting the function.
In real-world use you'd have to use a TInterfacedObject. If you pass the interface references around a lot it might help though.

Delphi: How to set field value of a generic using RTTI?

I'd like to fill the field of a generic object at runtime using D2010.
program generic_rtti_1;
{$APPTYPE CONSOLE}
uses
SysUtils, rtti;
type
TMyObject = class
FField1: string;
end;
TGeneric<TElement: class> = class
procedure FillFields(Element: TElement);
end;
procedure TGeneric<TElement>.FillFields(Element: TElement);
var
ctx: TRttiContext;
begin
ctx := TRttiContext.Create();
ctx.GetType(TypeInfo(TElement)).GetField('FField1').
SetValue(#Element, TValue.FromVariant('Some string'));
ctx.Free();
end;
When the line ctx.Free(); is executed, I get an AV at line 21986 in System.pas (function _IntfClear()). This is called from FContextToken := nil in rtti.pas. (In fact, the SetValue-induced AV pops up if I step into SetValue, however if step over it, only the ctx.Free-induced is reported. See below.)
If I remove ctx.Free();, the AV appears when calling SetValue(#Element, TValue.FromVariant('Some string'));. This too at line 21986 in System.pas.
Trying to figure this mess out, I replaced
ctx.GetType(TypeInfo(TElement)).GetField('FField1').
SetValue(#Element, TValue.FromVariant('Field 1 is set'));
with this:
rType := ctx.GetType(TypeInfo(TElement));
rField := rType.GetField('FField1');
Val := TValue.FromVariant('Field 1 is set');
rField.SetValue(#Element, Val);
This time, I got no error, however WriteLn(MyObject.FField1) printed an empty string. (The AV re-appears if I combine SetValue and TValue.FromVariant, i.e. write rField.SetValue(#Element, TValue.FromVariant('Field 1 is set'));.
In order to pinpoint the guilty line, I commented out line by line, replacing the commented code with a compound statement. By accident I forgot to comment out the Val := TValue.FromVariant('Field 1 is set');-line above, which causes the AV to disappear once more (still calling rField.SetValue(#Element, TValue.FromVariant('Field 1 is set'));). (Note that I don't actually use Val in the troublesome call, still the AV disappears.)
I'm kind'a lost at this point.
For sake of completeness, here's how I'd like to use the above code:
var
Generic: TGeneric<TMyObject>;
MyObject: TMyObject;
begin
MyObject := TMyObject.Create();
Generic := TGeneric<TMyObject>.Create();
Generic.FillFields();
WriteLn(MyObject.FField1);
Generic.Free();
MyObject.Free();
ReadLn;
end;
end.
Do anyone know what I'm doing wrong? (Is this even possible? Are there better ways to do this using generics? )
Well, I don't know if this makes sense to you guys, but here's how I solved it. Hard cast to TObject in procedure TGeneric<TElement>.FillFields works like a charm. Like so:
ctx.GetType(TypeInfo(TElement)).GetField('FField1').
SetValue(TObject(Element), TValue.FromVariant('Field 1 is set'));
Hope this is useful to someone else out there.

Can I use generics to do the same operation on similar types of controls?

I am using Delphi 2010 and I have a unit where over the years I have added my own procedures and functions that can be used with any project I make, such as:
function ListBoxIsSelected(ListBox: TListBox): Boolean;
begin
Result:= ListBox.ItemIndex <> -1;
end;
The above uses TListBox as a parameter, so whenever the above function is used I must supply a listbox that is of TListBox class.
Now suppose I have some other component libraries that could work with the same function, For example the Jedi component classes.
How could I use the above function, when the Jedi listbox is TJvListBox class and my function is looking for TListBox class? Although both components are practically the same, the class names are different. If I provided the same function specifically for the TJvListBox it would likely work because they are both "listboxes":
function ListBoxIsSelected(ListBox: TJvListBox): Boolean;
begin
Result:= ListBox.ItemIndex <> -1;
end;
Now, I have whole load of procedures and functions written in the same kind of way where I need to pass a component as a parameter. Having to rewrite them again just to work with a different component class is not feasible!
How can I write this with generics?
You can't write that with generics, unless your target classes all descend from the same base class of course. (But then you wouldn't need generics for it.)
If you really want something that can check if the ItemIndex property on any object <> -1, though, you can do that with a different Delphi 2010 feature: extended RTTI.
uses
SysUtils, RTTI;
function IsSelected(item: TObject): boolean;
var
context: TRttiContext;
cls: TRttiType;
prop: TRttiProperty;
ItemIndex: integer;
begin
if item = nil then
raise Exception.Create('Item = nil');
context := TRttiContext.Create;
cls := context.GetType(item.ClassType);
prop := cls.GetProperty('ItemIndex');
if prop = nil then
raise Exception.Create('Item does not contain an ItemIndex property.');
ItemIndex := prop.GetValue(item).AsInteger;
result := ItemIndex <> -1;
end;
Careful, though. There's no compile-time type checking here, and this process is significantly slower than your original routine. You probably won't notice it, but if you call something like this in a tight loop, it will slow it down.
I don't understand how I can write this with Generics?
You can’t – not unless your component implements a common interface or inherits from a common base class with the standard ListBox, and that interface / base class offers the ItemIndex property.
In fact, this use-case isn’t such a great example of generics because using an interface or base class in the declaration would work just as well.
In this case, you can write two overloaded functions, one expecting TJvListBox and the other expecting TListBox.
In more complex cases this approach may not apply so well, but I think your case is simple enough for this solution.
I cannot look it up right now (on holiday, no Delphi), but don't TJvListBox and TListBox descend from a common ancestor (my guess would be: TCustomListBox)? In that case something like this should work:
interface
function TListBox_IsItemSelected(_ListBox: TCustomListBox): boolean;
implementation
function TListBox_IsItemSelected(_ListBox: TCustomListBox): boolean;
begin
Result := _ListBox.ItemIndex <> -1;
end;
Just in case ItemIndex (as I said: I cannot check right now) is protected in TCustomListBox, you can just use a typecast hack:
type
TListBoxHack = class(TCustomListBox)
end;
function TListBox_IsItemSelected(_ListBox: TCustomListBox): boolean;
begin
Result := TListBoxHack(_ListBox).ItemIndex <> -1;
end;
(I just thought I should mention this since the original question has already been answered: Using Generics does not help here.)

Accessing Sub functions /procedures from DPR or other function / procedure in Delphi

As much I know - Subroutines are with Private access mode to its parent unction / procedure, right?
Is there any way to access them from "outer-world" - dpr or other function / procedure in unit?
Also - which way takes more calcualtion and space to compiled file?
for example:
function blablabla(parameter : tparameter) : abcde;
procedure xyz(par_ : tpar_);
begin
// ...
end;
begin
// ...
end;
procedure albalbalb(param : tparam) : www;
begin
xyz(par_ : tpar_); // is there any way to make this function public / published to access it therefore enabling to call it this way?
end;
// all text is random.
// also, is there way to call it from DPR in this manner?
// in C++ this can be done by specifing access mode and/or using "Friend" class .. but in DELPHI?
Nested procedures/functions - those declared inside another procedure or function, are a special type, because they can access the stack (and thereby parameters/local variables) of the procedure they are nested in. Because of this, and Delphi scope rules, there is no way to access them outside the "parent" procedure. You use them only if you need to take advantage of their special features. AFAIK Delphi/Pascal is one of the few languages to have this feature. From a compiler point of view the call has some extra code to allow accessing the parent stack frame, IIRC.
AFAIK "friend" class/functions in C++ are different - they are class access methods, while in your example you are using plain procedures/functions.
In Delphi all procedure/classes declared in the same unit are automatically "friend", unless strict private declarations are used in latest Delphi releases. For example this code snippets will work, as long everything is in the same unit:
type
TExample = class
private
procedure HelloWorld;
public
...
end;
implementation
function DoSomething(AExample: TExample);
begin
// Calling a private method here works
AExample.HelloWordl;
end;
Note: Embedded Routines <> Private/Protected Methods.
Embedded routines i.e. routines inside routines can not be accessed by external routines.
You have posted an example of an Embedded routine, I also heard them called Internal Routines.
Here is another example:
procedure DoThis;
function DoThat : Boolean;
begin
// This Routine is embedded or internal routine.
end;
begin
// DoThat() can only be accessed from here no other place.
end;
Regardless of visibility, methods on classes, can be called using Delphi 2010 via RTTI. I have detailed how to do this in this article.
If you are in the same Unit methods on a class can be accessed by any other code regardless of visibility, unless they are marked with Strict Private. This Question has more details and good example code in the accepted answer.
If you are in two different units you can use the Protected Method Hack to access the protected methods. Which is detailed in detailed in this article.
Yes, you can access a subroutine, which is nested in other (parent) subroutine, from the outer world. Though it's somewhat tricky. I've found this howto in the web.
How to pass nested routine as a procedural parameter (32 bit)
Delphi normally does not support passing nested routines as procedural parameters:
// This code does not compile:
procedure testpass(p: tprocedure);
begin
p;
end;
procedure calltestpass;
procedure inner;
begin
showmessage('hello');
end;
begin
testpass(inner);
end;
The obvious workaround is to pass procedure address and typecast it within testpass:
// This code compiles and runs OK
procedure testpass(p: pointer);
begin
tProcedure(p);
end;
procedure calltestpass;
procedure inner;
begin
showmessage('hello');
end;
begin
testpass(#inner);
end;
There is, however, a pitfall in the above example - if the "inner" routine references any variable that was pushed onto the stack before the "inner" procedure was called from testpass (calltestpass parameters - if there were any, or local variables in calltestpass - if there were any), your system most probably crashes:
// This code compiles OK but generates runtime exception (could even be
// EMachineHangs :-) )
procedure testpass(p: pointer);
begin
tProcedure(p);
end;
procedure calltestpass;
var msg: string;
procedure inner;
begin
msg := 'hello';
showmessage(msg);
end;
begin
testpass(#inner);
end;
The reason is, in simple words, that the stack frame arrangement
was "broken" by the call to testpass routine and "inner" procedure
incorrectly calculates parameters and local variables location
(do not blame Delphi, please).
The workaround is to set up the correct stack context before
"inner" is called from within "testpass".
// This code compiles and runs OK
{$O-}
procedure testpass(p: pointer);
var callersBP: longint;
begin
asm // get caller's base pointer value at the very beginning
push dword ptr [ebp]
pop callersBP
end;
// here we can have some other OP code
asm // pushes caller's base pointer value onto stack and calls tProcedure(p)
push CallersBP
Call p
Pop CallersBP
end;
// here we can have some other OP code
end;
{$O+}
procedure calltestpass;
var msg: string;
procedure inner;
begin
msg := 'hello';
showmessage(msg);
end;
begin
testpass(#inner);
end;
Please note the optimization is switched OFF for testpass routine - optimization generally does not handle mixed OP/assembler code very well.
No, there is no way to do what you're asking. The xyz function is callable only by the enclosing blablabla function. Outside that function, xyz is not in scope and there is no way to name it. If C++ allowed nested function, there wouldn't be any way to refer to it, either, just like there's no way to refer to functions with static linkage from outside the current translation unit.
If you need to call xyz from outside the blablabla function, then move xyz outside. If you need to call it from outside the current unit, then you need to declare that function in the unit's interface section. Then, add that unit to the external code's uses clause and you can call xyz from wherever you want, even the DPR file.
If xyz refers to variables or parameters of the blablabla function, then you'll need to pass them in as parameters since xyz will no longer have access to them otherwise.
The concept of access specifiers isn't really relevant here since we're not talking about classes. Units have interface and implementation sections, which aren't really the same as public and private sections of a class.

Resources