Consider the following test-case:
{ CompilerVersion = 21 }
procedure Global();
procedure Local();
begin
end;
type
TProcedure = procedure ();
var
Proc: TProcedure;
begin
Proc := Local; { E2094 Local procedure/function 'Local' assigned to procedure variable }
end;
At line 13 compiler emits message with ERROR level, prohibiting all of the cases of such local procedures usage. "Official" resolution is to promote Local symbol to the outer scope (ie: make it a sibling of Global) which would have negative impact on code "structuredness".
I'm seeking the way to circumvent it in most graceful manner, preferably causing compiler to emit WARNING level message.
Your best bet is to declare it as reference to procedure using the new anonymous methods feature and then you can keep everything nicely encapsulated.
type
TProc = reference to procedure;
procedure Outer;
var
Local: TProc;
begin
Local := procedure
begin
DoStuff;
end;
Local;
end;
This gets around the issues that Mason describes by capturing any variables local to the anonymous function.
Here's why you can't do it:
type
TProcedure = procedure ();
function Global(): TProcedure;
var
localint: integer;
procedure Local();
begin
localint := localint + 5;
end;
begin
result := Local;
end;
Local procedures have access to the outer routine's variable scope. Those variables are declared on the stack, though, and become invalid once the outer procedure returns.
However, if you're using CompilerVersion 21 (Delphi 2010), you've got anonymous methods available, which should be able to do what you're looking for; you just need a slightly different syntax.
If one really needs to use local procedures in D7 or earlier one could use this trick:
procedure GlobalProc;
var t,maxx:integer; itr,flag1,flag2:boolean; iterat10n:pointer;
//Local procs:
procedure iterat10n_01;begin {code #1 here} end;
procedure iterat10n_10;begin {code #2 here} end;
procedure iterat10n_11;begin {code #1+#2 here} end;
begin
//...
t:=ord(flag2)*$10 or ord(flag1);
if t=$11 then iterat10n:=#iterat10n_11
else if t=$10 then iterat10n:=#iterat10n_10
else if t=$01 then iterat10n:=#iterat10n_01
else iterat10n:=nil;
itr:=(iterat10n<>nil);
//...
for t:=1 to maxx do begin
//...
if(itr)then asm
push ebp;
call iterat10n;
pop ecx;
end;
//...
end;
//...
end;
However the problem is that adress-registers could differ on different machines - so it's needed to write some code using local proc call and look via breakpoint which registers are used there...
And yeah - in most real production cases this trick is just some kind of palliative.
For the records, my homebrewn closure:
{ this type looks "leaked" }
type TFunction = function (): Integer;
function MyFunction(): TFunction;
{$J+ move it outside the stack segment!}
const Answer: Integer = 42;
function Local(): Integer;
begin
Result := Answer;
{ just some side effect }
Answer := Answer + Answer div 2;
end;
begin
Result := #Local;
end;
procedure TForm1.FormClick(Sender: TObject);
var
Func: TFunction;
N: Integer;
begin
{ unfolded for clarity }
Func := MyFunction();
N := Func();
ShowMessageFmt('Answer: %d', [N]);
end;
Related
when implementing an Event with the definition below Spring4D will add and invoke method but will not remove handler ( with IEvent<TaskItemChangeEvent>.Remove(MyProc) ) when asked as it does not identify it.
{$M+}
TaskItemChangeEvent = reference to procedure(const TaskItem: ITaskItem; Event: TTaskListEvent);
The following does work but I do not want to be forced to be bound to an object.
{$M+}
TaskItemChangeEvent = procedure(const TaskItem: ITaskItem; Event: TTaskListEvent) of Object;
I believe the issue is this line in TEventBase.Remove as a reference to procedure is not a TMethod?
if TMethod(handlers[i]) = TMethod(handler) then
The reason is the compiler possibly creating different instances of the anonymous method between the place where you add and where you remove them.
Look at the following code:
var
proc: TProc;
procedure Add(p: TProc);
begin
proc := p;
end;
procedure Remove(p: TProc);
begin
Writeln(PPointer(#proc)^ = PPointer(#p)^);
end;
procedure A;
var
p: TProc;
begin
p := procedure begin end;
Add(p);
Remove(p);
end;
procedure B;
begin
Add(procedure begin end);
Remove(procedure begin end);
end;
procedure C;
begin
Add(A);
Remove(A);
end;
begin
A;
B;
C;
Readln;
end.
You will notice that in B and C it will print False because the two anonymous methods being passed to Add and Remove differ from each other. While in B it's obvious in C it is not but the compiler actually transforms the code into this:
procedure C;
begin
Add(procedure begin A(); end);
Remove(procedure begin A(); end);
end;
That means if you want to use IEvent<> with a method reference type and be able to remove you need to keep the reference that you added in order for them to be equal and thus be able to be found when calling Remove.
The fact that internally in TEventBase the references are all handled as TMethod has nothing to do with that - when passing an anonymous method it is being transformed into a TMethod. After all an anonymous method type is an interface being backed by an object which the compiler creates which makes it possible to do such conversion and causes the necessity to keep the reference that was added in order to remove it.
Consider:
function OuterFunc: integer;
function InnerFunc: integer;
begin
// Here I'd like to access the OuterFunc.Result variable
// for both reading and writing its value
OuterFunc.Result := OuterFunc.Result + 12;
end;
begin
end;
Is there a native syntax to access the OuterFunc Result variable inside InnerFunc? Or is the only way to do this to pass it like a parameter, as in the following?
function OuterFunc: integer;
function InnerFunc(var outerResult: integer): integer;
begin
end;
var
i: integer;
begin
i := InnerFunc(Result);
end;
You can assign result to functions by assigning to the function name, which actually was the original way in Pascal:
function MyFunc: integer;
begin
MyFunc := 2;
// is equal to the following
Result := 2;
end;
So in your case you can write
function OuterFunc: integer;
function InnerFunc: integer;
begin
OuterFunc := 12;
end;
begin
end;
Beware however, that using the function name in a statement block anyware else than on the left side of the assignment operator results in a recursive call, and is therefore different from how the predefined Result works.
In other words, you can not access a previously set value of OuterFunc from within InnerFunc. You would need to use e.g. a local variable in the outer scope defined before InnerFunc to be accessible also from InnerFunc:
function OuterFunc: integer;
var
OuterResult: integer;
function InnerFunc: integer;
begin
OuterResult := 0;
OuterResult := OuterResult + 12;
end;
begin
Result := OuterResult;
end;
For more details refer to Function Declarations in the documentation.
Another option, except for using the native Pascal syntax (as displayed by Tom Brunberg's answer), is converting the local function into a procedure.
function OuterFunc: integer;
procedure InnerFunc(out innerResult: integer);
begin
{OuterFunc's} Result := 0;
innerReuslt := -1;
end;
var
i: integer;
begin
InnerFunc( i );
end;
Since this is your INNER local function you would not break some external API/contract by this simple change.
Twice so since your original code has InnerFunc being the de facto procedure, making no use of its own Result neither by caller, nor by callee.
function OuterFunc: integer;
// function InnerFunc: integer;
procedure InnerFunc;
begin
// here i'd like to access OuterFunc.Result variable
// for both reading and writing its value
// OuterFunc.Result := OuterFunc.Result + 12;
Result := Result + 12;
end;
begin
InnerFunc();
end;
But okay, let's assume you just forgot using BOTH results of BOTH functions, but you did originally intend to.
Still there are few ways at your disposal to cut corners and to hack over the Delphi language intentions-limitations.
Starting with that procedure approach, you may add a function shorthand, if you want to use such a function in expressions.
Though it looks a bit ugly and adds a redirection call for the CPU (you can not inline local functions and if you could Delphi inline implementation is bogged with "register dances"), so slows things down somewhat (but depending on how much you call it w.r.t. other work - that extra work might be non-noticeable).
function OuterFunc: integer;
procedure InnerFunc(out innerResult: integer); overload;
begin
innerResult := +2;
// {OuterFunc's} Result := Result + innerResult;
Inc( Result, innerResult );
end;
function InnerFunc: integer; overload;
begin
InnerFunc( Result );
end;
var
i: integer;
begin
// InnerFunc( i );
i := InnerFunc();
end;
And yet another hack is declaring the variables overlapping.
function OuterFunc: integer;
var Outer_Result: integer absolute Result;
i: integer;
function InnerFunc: integer;
begin
Result := +2;
Inc( Outer_Result, Result );
end;
begin
i := InnerFunc();
end;
Now, this approach might kill the optimizations, like placing the "result" in the CPU registers, forcing using the RAM for it, which is slower.
Additionally, once you might wish to change the type of the OuterFunc and if you forget to change the type of the Outer_Result var accordingly - you screwed yourself.
function OuterFunc: double; // was - integer; Proved to be not enough since 2020
var Outer_Result: integer absolute Result; // and here we forgot to sync type changing.... ooooops!
i: integer;
function InnerFunc: integer;
....
So less hackish way to express that intention (at the price of allocating and accessing yet one more in-RAM variable) would be this:
function OuterFunc: integer;
{$T+} // we need to enable type checking: predictability is safety
var Outer_Result: ^integer;
i: integer;
function InnerFunc: integer;
begin
Result := +2;
Inc( Outer_Result^, Result );
end;
begin
Outer_Result := #Result;
i := InnerFunc();
end;
But all these options are hack-arounds, breaking conceptual clarity, thus hampering ability for people to read/understand the program in the future.
If you need the variable - then do declare the variable. That would be the most clear option here. Afterall programs are more written for the future programmers to read them than for the computers to compile them. :-)
function OuterFunc: integer;
var the_Outer_Result: integer;
function InnerFunc;
begin
Result := +2;
Inc( the_Outer_Result, Result );
end;
var
i: integer;
begin
the_Outer_Result := 0;
.....
I := InnerFunc();
.....
Result := the_Outer_Result;
end;
That way you would not fight with the language, but give up and use it as it was intended to use. Fighting and outsmarting the language is always fun, but in the long term, when you have to maintain the code any human being last read 5 years ago and port it to newer versions of Delphi/libraries/Windows - then such the non-natural smart tricks tend to become quite annoying.
procedure DoSomething;
var
MyAnonymousProcedure : TProc;
begin
//assign an anonymous procedure to a variable.
MyAnonymousProcedure := procedure
begin
Foo;
end;
MyAnonymousProcedure(); //Call the newly assigned procedure.
// do the same thing again but with a different anonymous method.
MyAnonymousProcedure := procedure
begin
Bar;
end;
MyAnonymousProcedure();
end;
In the above code there are two anonymous procedures. They are assigned to the same TProc variable in turn. The code in each anonymous procedure is clearly different. Is there a way to find the executable code that the MyAnonymousProcedure variable references? I guess that would be a memory location. From there is it possible to then calculate the hash of the executable code found at that memory location?
Is there a way to find the executable code that the
MyAnonymousProcedure variable references?
There is always "a way" but it is tricky in this case.
First an anonymous method can be treated as a reference to interface with a single Invoke method as explained by Barry Kelly.
Applying the idea to your code we get:
procedure MethRefToProcPtr(const MethRef; var ProcPtr);
type
TVtable = array[0..3] of Pointer;
PVtable = ^TVtable;
PPVtable = ^PVtable;
begin
// 3 is offset of Invoke, after QI, AddRef, Release
TMethod(ProcPtr).Code := PPVtable(MethRef)^^[3];
end;
Unfortunately the ProcPtr value returned is not what you probably want - it is an address of a stub code that fixes an interface reference (converts an interface reference to an object reference) and jumps to the address we are looking for. If you trace the code pointed by ProcPtr you will find something like this (Delphi XE, 32-bits):
add eax,-$10
jmp FooBar
and at the FooBar address you will find
call Foo
or
call Bar
dependent of the current value of your anonymous method.
I guess the only way to get the FooBar address now is to parse the assembler jmp instruction.
Here is the code I used for my experiments:
procedure Foo;
begin
Writeln('Foo');
end;
procedure Bar;
begin
Writeln('Bar');
end;
procedure MethRefToProcPtr(const MethRef; var ProcPtr);
type
TVtable = array[0..3] of Pointer;
PVtable = ^TVtable;
PPVtable = ^PVtable;
begin
// 3 is offset of Invoke, after QI, AddRef, Release
TMethod(ProcPtr).Code := PPVtable(MethRef)^^[3];
end;
procedure DoSomething;
var
MyAnonymousProcedure : TProc;
MyProc : procedure;
begin
//assign an anonymous procedure to a variable.
MyAnonymousProcedure := procedure
begin
Foo;
end;
// MyAnonymousProcedure(); //Call the newly assigned procedure.
MethRefToProcPtr(MyAnonymousProcedure, MyProc);
Writeln(Format('%p', [#MyProc]));
Writeln(Format('%p', [#Foo]));
MyProc;
// do the same thing again but with a different anonymous method.
MyAnonymousProcedure := procedure
begin
Bar;
end;
// MyAnonymousProcedure();
MethRefToProcPtr(MyAnonymousProcedure, MyProc);
Writeln(Format('%p', [#MyProc]));
Writeln(Format('%p', [#Bar]));
MyProc;
end;
In addition to the other answer here is a routine that converts the compiler generated method stub that fixes the eax to the "real" method of the compiler generated class for the anonymous method.
procedure MethodStubToMethod(const Method; var Result);
var
offset: ShortInt;
begin
offset := PByte(TMethod(Method).Code)[2];
TMethod(Result).Code := PByte(TMethod(Method).Code) + 3;
TMethod(Result).Data := PByte(TMethod(Method).Data) + offset;
end;
It's a simple and naive implementation that assumes that the offset will never get bigger than one byte (which only would happen if you have hundred different anonymous methods within the same routine (like you have 2 in the original source in the question).
It assumes the layout of the stub is like this (which it for anonymous methods afaik)
add eax, offset
jmp address
Then you can write:
procedure MethRefToProcPtr(const MethRef; var ProcPtr);
type
TVtable = array[0..3] of Pointer;
PVtable = ^TVtable;
PPVtable = ^PVtable;
begin
// 3 is offset of Invoke, after QI, AddRef, Release
TMethod(ProcPtr).Code := PPVtable(MethRef)^^[3];
TMethod(ProcPtr).Data := Pointer(MethRef);
end;
procedure DoSomething;
var
MyAnonymousProcedure: TProc;
Method: procedure of object;
begin
//assign an anonymous procedure to a variable.
MyAnonymousProcedure := procedure
begin
Foo;
end;
MyAnonymousProcedure(); //Call the newly assigned procedure.
MethRefToProcPtr(MyAnonymousProcedure, Method); //
Method(); //same as calling the anonymous method
MethodStubToMethod(Method, Method)
Method(); // now we are calling the method directly on the object
end;
This is just a very simple question to which i can't find a good clear answer to. I don't quite have the time to read all the documentation for this since i'm in a time crunch.
But here it is.
I have made a new class on top of my TForm class like so:
Bucket = Class
glass: Integer;
steel: Integer;
End;
I then create a couple of objects in a method which belongs to TForm1
procedure TForm1.getMarbles;
var
objPlastic: Bucket;
objAlu: Bucket;
begin
// Initialize objects
objPlastic := Bucket.Create;
objAlu := Bucket.Create;
// Get Values from edtBox
val(Edit1.Text, objPlastic.steel, code);
val(Edit2.Text, objAlu.steel, code);
val(Edit3.Text, objPlastic.glass, code);
val(Edit4.Text, objAlu.glass, code);
end;
My problem is that I don't know how to use these objects in other methods. I tried defining them in every way i know so far in the other methods I want to use them in, but I can't get it to work.
Here is the method and what I have it currently set to (which returns 0 all the time):
procedure TForm1.marbleDrop(kind: string);
var
objPlastic: Bucket;
I: Integer;
begin
objPlastic := Bucket.Create;
if kind= 'plastic' then // the function is receiving this parameter
begin
for I := 0 to objPlastic.glass do
begin
showmessage(inttostr(objPlastic.glass)); //returns 0
end;
end;
end;
Sorry for this kind of question, but i couldn't find a better way.
BTW, this is a simplified version of the code I am using. I did my best to get out any typos since it's a translation of what I am actually using, but it's mainly about the idea. I don't have typos in my code in delphi.
In other to access the objects across methods, you have to either:
declare the objects as members of the Form class:
type
TForm1 = class(TForm);
...
private
objPlastic: Bucket;
objAlu: Bucket;
...
end;
procedure TForm1.getMarbles;
begin
// Initialize objects
if objPlastic = nil then objPlastic := Bucket.Create;
if objAlu = nil then objAlu := Bucket.Create;
// Get Values from edtBox
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objAlu.steel := StrToIntDef(Edit2.Text, 0);
objPlastic.glass := StrToIntDef(Edit3.Text, 0);
objAlu.glass := StrToIntDef(Edit4.Text, 0);
end;
procedure TForm1.marbleDrop(kind: string);
begin
if (kind = 'plastic') and (objPlastic <> nil) then
begin
ShowMessage(IntToStr(objPlastic.glass));
end;
end;
pass them as parameters of the methods themselves:
procedure TForm1.getMarbles(objPlastic, objAlu: Bucket);
begin
// Get Values from edtBox
if objPlastic <> nil then
begin
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objPlastic.glass := StrToIntDef(Edit3.Text, 0);
end;
if objAlu <> nil then
begin
objAlu.steel := StrToIntDef(Edit2.Text, 0);
objAlu.glass := StrToIntDef(Edit4.Text, 0);
end;
end;
procedure TForm1.marbleDrop(objWhichKind: Bucket);
begin
if objWhichKind <> nil then
begin
ShowMessage(IntToStr(objWhichKind.glass));
end;
end;
procedure TForm1.someMethod();
var
objPlastic: Bucket;
begin
objPlastic := Bucket.Create;
getMarbles(objPlastic, nil);
marbleDrop(objPlastic);
objPlastic.Free;
end;
Of course it returns zero. It is another object. You should pass it as you pass any other parameter variable. What you made is similar to
procedure TForm1.Drop1(kind: string);
begin
marbleDrop(); // here kind = "staal"
end;
procedure TForm1.marbleDrop();
var
kind: string;
begin
if kind = 'plastic' then // it is not !!! why ???
begin
....
end;
end;
You also has another problem - Memory leak
val(Edit4.Text, objAlu.glass, code);
end;
You just created two objects - and allocated Heap memory for them.
But you did not freed them. That is garbage left and it will grow and grow and grow - until the program would exhaust all Windows memory and be killed.
If you want to use memory without any accuracy and without "wasting" your time on thinking and learning - you'd better user some managed language running in virtual machine, like PHP, Python, Java and other JVM-based, C# and other .NEt-based.
To make good Delphi code you should have at least some understanding what you CPU does and why.
Specifically in your code you'd better
use records instead of classes
pass them as const- or var-parameters to avoid redundant copying.
Like that:
type TBucket = Record glass, steel: Integer; End;
type TForm1 = class (TForm)
.....
private
var objPlastic, objAlu: TBucket;
(* making variables more global: now they are form-local not function-local *)
......
procedure TForm1.getMarbles;
begin
objPlastic.steel := StrToIntDef(Edit1.Text, 0);
objAlu.steel := ...
Self.objPlastic.glass ... (* adding Self - just for clarity where those variable are taken from *)
Self.objAlu.glass ....
end;
procedure TForm1.marbleDrop(kind: string);
var
I: Integer;
begin
if kind = 'plastic' then // the function is receiving this parameter
begin
for I := 0 to Self.objPlastic.glass do
begin
showmessage(inttostr(objPlastic.glass));
//getting via common parent context - TForm1 object, referenced as Self pseudo-variable
marbleTell(objPlastic); // passing as parameter
end;
end;
end;
procedure TForm1.marbleTell(const arg: TBucket);
// do not forget to use const to pass variable by-reference not by-value
begin
showmessage(inttostr(arg.glass)); // getting via argument
end;
I know what changed. I know why. But..
TComplicatedCallMaker = record
Param1: TRecordType;
Param2: TRecordType;
{...}
Param15: TRecordType;
procedure Call;
end;
function ComplicatedCall: TComplicatedCallMaker;
begin
{ Fill default param values }
end;
procedure DoingSomeWorkHere;
begin
with ComplicatedCall do begin
Param7 := Value7;
Param12 := Value12;
Call;
end;
end;
This has perfectly worked before Delphi 2010. An extremely useful technique for making calls which accept a load of parameters but usually only need two or three. Never the same ones though.
And now it gives... guess what?
E2064: Left side cannot be assigned to.
Can't this helpful new behavior be disabled somehow? Any ideas on how to modify the pattern so it works?
Because seriously, losing such a handy technique (and rewriting a bunch of code) for no apparent reason...
I find it a little surprising that this ever worked but since you say it did I'm sure you are right. I'd guess the change was made without consideration for record methods. Without the ability to call methods then this construct would be rather pointless.
Anyway, the compiler isn't going to let you off the hook on this one so you'll have to do this:
type
TRecordType = record end;
TComplicatedCallMaker = record
Param1: TRecordType;
procedure Call;
end;
function ComplicatedCall: TComplicatedCallMaker;
begin
{ Fill default param values }
end;
procedure DoingSomeWorkHere(const Value: TRecordType);
var
CallMaker: TComplicatedCallMaker;
begin
CallMaker := ComplicatedCall;
with CallMaker do begin
Param1 := Value;
Call;
end;
end;
I... think I did it
I hope Delphi developers see what they make their programmers do!
type
PCallMaker = ^TCallMaker;
TCallMaker = record
Param1: integer;
Param2: integer;
function This: PCallMaker; inline;
procedure Call; inline;
end;
function TCallMaker.This: PCallMaker;
begin
Result := #Self;
{ Record functions HAVE to have correct self-pointer,
or they wouldn’t be able to modify data. }
end;
procedure TCallMaker.Call;
begin
writeln(Param1, ' ', Param2);
end;
function CallMaker: TCallMaker; inline
begin
Result.Param1 := 0;
Result.Param2 := 0;
end;
procedure DoingSomeWorkHere;
var cm: TCallMaker;
begin
{Test the assumption that cm is consistent}
cm := CallMaker;
if cm.This <> #cm then
raise Exception.Create('This wasn''t our lucky day.');
{Make a call}
with CallMaker.This^ do begin
Param1 := 100;
Param2 := 500;
Call;
end;
end;
This works, preserves all the good points of the old version (speed, simplicity, small call overhead) but aren't there any hidden problems with this approach?