How to tell an object to execute a message - message

I have an object, and a string containing a message I would like to send to it.
For example, the string '+ 5', which I would like to send to some integer object.
If it was in the workspace then I would just write "obj + 5", but I need it to be done at running time without knowing the string in advance...

If you can separate the argument of the message from the message itself, then you can "perform" the message send:
obj := 3.
msg := '+'.
arg := 5.
result := obj perform: msg asSymbol with: arg.
Otherwise, you would have to use the Compiler, which would translate the string into compiled code and execute it:
obj := 3.
msg := 'self + 5'.
result := Compiler evaluate: msg for: obj logged: false.
A common technique to avoid repeated compilation is to compile a block, which can be evaluated more efficiently:
obj := 3.
msg := '[:x | x + 5]'.
block := Compiler evaluate: msg.
result := block value: obj.
Btw, the code above (and below) is for Squeak, other Smalltalks may have a different way to access the Compiler.
There is an even more hackish way that lets you access the variable directly from the string. This is by executing the compiled code in "thisContext" (in this case you need to declare the temp vars even in a workspace):
| obj msg result |
obj := 3.
msg := 'obj + 5'.
result := Compiler new evaluate: msg in: thisContext to: nil.
However, I would not recommend this last technique. Performing is generally safer than involving the Compiler. That said, it can be used to implement some serious meta stuff. E.g.:
| obj |
obj := 3.
'The result is {obj + 5}.' expand
Implementation of the "expand" method is left to the curious reader ;)

Related

Typeinfo with record type does not work at runtime

I have a little problem with compilation under Delphi:
function T_QS2ProcessMailbox.PutRec<T>(const aID: T_Barcode; var aRec: T;const aTxt: String): Boolean;
var
FA: T_FahrauftragRec absolute aRec;
LP: T_LagerpackungRec absolute aRec;
begin
init_Rec;
Rec.ID := aID;
Rec.EventTime := Now;
Rec.Text := aTxt;
if TypeInfo(T_LagerpackungRec) = TypeInfo(T) then
begin
Rec.RecType := C_QS_TYPE_TLAGERPACKUNGREC;
Rec.FA := FA;
end
else
if Typeinfo(T) = Typeinfo(T_LagerpackungRec) then
begin
Rec.RecType := C_QS_TYPE_TFAHRAUFTRAGREC;
Rec.LP := LP;
end
else
Rec.RecType := C_QS_TYPE_TEXT;
Send_TraceMsg(ClassName + '.PutRec Type=' + IntToStr(Rec.RecType));
Result := PutRec(Rec);
end;
It compiles fine without errors, messages, or hints. But it is compiled without if statements. You can look at it in the picture - this code without compilations marker
I do not understand why.
Can somebody explain to me what I am doing incorrectly?
Those if statements can be resolved at compile time, so only ever 1 of them will be actually compiled for any given value of T. (In other word, the compiled code will never execute any if for this function).
I can imagine 2 reasons for seeing only 1 compilation marker. Either your application will only ever use 1 of the if statements, or the IDE will map the compilation marker of all the if statements to the same line (I find this last one unlikely, but I've seen stranger things in the IDE).
Another possibility is that your 2nd if should read
if Typeinfo(T) = Typeinfo(T_FahrauftragRec) then
instead of
if Typeinfo(T) = Typeinfo(T_LagerpackungRec) then
Typeinfo() is a compiler intrinsic function in XE7 and later, and thus is available for the compiler to evaluate at compile-time 1. And since the type of T is a Generic that is also known to the compiler, the compiler can directly evaluate your ifs and any blocks that evaluate to False and would never be executed at runtime are simply omitted from the final executable altogether. That is why you don't see any debugger points on them.
1: but only in the specific case where TypeInfo(T) is used in an if TypeInfo(T) = TypeInfo(X) statement inside a Generic method. Other uses of TypeInfo() are not similarly inlined at compile-time.
This is normal behavior, and is what you WANT to have happened, as it produces slimmer and more efficient runtime code.
When your other code calls PutRec<T_FahrauftragRec>(...) then T will be T_FahrauftragRec and thus TypeInfo(T_LagerpackungRec) = TypeInfo(T_FahrauftragRec) will evaluate as False.
Likewise, when calling PutRec<T_LagerpackungRec>(...) then T will be T_LagerpackungRec and thus TypeInfo(T_FahrauftragRec) = TypeInfo(T_LagerpackungRec) will evaluate as False.
And so on for any other type you pass to T.
Also, you have a bug in your code. Your second if statement:
if Typeinfo(T) = Typeinfo(T_LagerpackungRec) then
Should be this instead:
if Typeinfo(T) = Typeinfo(T_FahrauftragRec) then

Spring4d: Spring.Collections.IEnumerator and System.IEnumerator

I have a problem that should be trivial but to which I can't find any elegant answer.
I have an instance of a IList<string> and I want to get a comma-separated string of all its distinct (case-insensitive) values.
I thought I'd just use the string.Join helper for that since it has a nice overload that accepts an IEnumerator<string> as parameter. Unfortunately, I see to have hit a snag: spring4d redefines IEnumerator<T> and, of course, use its own type everywhere.
The result is that the following code does not compile:
var
distinct: system.IEnumerator<string>;
begin
result := inherited GetToken;
if assigned(result) then
begin
if not Modules.Contains(STR_DID_SESSION_MODULE) then
Modules.Add(STR_DID_SESSION_MODULE);
distinct := TDistinctIterator<string>.Create(Modules, TIStringComparer.Ordinal);
result.CustomClaims.Items[STR_CLAIM_CUSTOM_MODULES] := string.Join(',', distinct);
end;
end;
The assignment to distinct fails with E2010 Incompatible types: 'System.IEnumerator<System.string>' and 'Spring.Collections.Extensions.TDistinctIterator<System.string>'
Alternatively, if I remove the namespace from distinct, it's the call to string.Join that fails.
Any idea how I should be doing that ? Short of manually walking through the iteration and performing the join manually?
Write it yourself (FWIW I would prefer opposite parameter order but I kept it like that since the signature of TStringHelper.Join):
function StringJoin(const separator: string; const values: Spring.Collections.IEnumerable<string>): string; overload;
var
e: Spring.Collections.IEnumerator<string>;
begin
e := values.GetEnumerator;
if not e.MoveNext then
Exit('');
Result := e.Current;
while e.MoveNext do
Result := Result + separator + e.Current;
end;
Also you can write the code way shorter (no need to manually create the iterator from Spring.Collections.Extensions):
StringJoin(',', TEnumerable.Distinct<string>(Modules, TStringComparer.OrdinalIgnoreCase))
Now if we had interface helpers we could easily write a helper for IEnumerable<string> and add ToDelimitedString or something like that.

Function result as enumerated type - how to proof all of variants are in case section

I have a enumerated type for some function result classification, and some case switch for controlling of function result.
How can I be sure - all of possible function result are covered in my case?
Example
type T_Function_Results = ( fr_None, fr_Ok, fr_Fail, fr_Unknown );
function Foo : T_Function_Results;
begin
// something ..
Result := fr_Unknown;
end;
begin
case Foo of
fr_None : ;
fr_Ok : ;
fr_Fail : ;
else : {I can use else, but it's not clear and runtime only } ;
end;
end.
In this example fr_Unknown result is not covered in case, and it's hard to see it. In ideal, I want a some compiler warning here.
You cannot get the compiler to issue a warning or an error in this case. The reason being is that it is perfectly valid for you to write code that chooses not to handle all of the enumeration's values. If the compiler were to issue a warning then it would be triggered by large amounts of perfectly valid code.
You can certainly arrange for your code to fail a runtime if it fails to handle one of the values. For instance:
case Foo of
fr_None:
;
fr_Ok:
;
fr_Fail:
;
else
raise EAssertionFailed.Create(...);
end;
I personally use this helper function:
procedure RaiseAssertionFailed;
begin
raise EAssertionFailed.CreateFmt(
'A critical error has occurred:' + sLineBreak + sLineBreak + 'Assertion failed at %p.',
[ReturnAddress]
) at ReturnAddress;
end;
which would be used like so:
case Foo of
....
else
RaiseAssertionFailed;
end;
If the job of your case statement is to assign to a local variable, or a result variable then the compiler might warn about uninitialized variables. For instance:
var
i: Integer;
....
case Foo of
fr_None:
i := 0;
fr_Ok:
i := 42;
fr_Fail:
i := 666;
end;
Bar(i);
I've used this a few times:
begin
case Foo of
fr_None : ;
fr_Ok : ;
fr_Fail : ;
end;
{$IF High(T_Function_Results) <> fr_Fail} Something Changed {$IFEND}
end.
How can I be sure - all of possible function result are covered in my case?
You cannot: that's why developers do exist. The IDE cannot warn you about code which is not at its best but is syntactically correct.
In a case like this you may consider to throw an exception at runtime when no declared case is matched.
case Foo of
fr_None: ;
fr_Ok: ;
fr_Fail: ;
else
raise Exception.Create('Not implemented');
end;
How can I be sure - all of possible function result are covered in my case?
If compiler can't warn about it then consider using static analysis tools.
RAD Studio has built-in QA Audits functionality that has the rule for check you are looking for.
Enumeration Constant is Not Handled in switch statement (ECNHS)
Description:
The compiler does not produce an error or warning when not all of the
enumeration constants are handled in a switch statement and no default
branch is provided. Although in many situations it is desired
behavior, it can also be programmer error; therefore, ECNHS produces
error messages in these cases. To eliminate this message and to
clarify your code, add the explicit default branch.
The availability of this feature depends on RAD Studio edition. QA Audits functionality is very limited in Delphi Professional edition, and does not allow to use above-mentioned check. But if you have Enterprise+ edition it might be the way to go.
Additionally you might consider to check 3d party static code analyzers (not free) like FixInsight, Peganza Pascal Analyzer, CodeHealer.

Is there any point of refactoring LUT array to case statement?

I've got the following LUT (lookup table) for retrieval of display name for pseudo-PChar (all these predefined PChars are integers under their skin, you know) input:
const
RT_MIN = DWORD(RT_CURSOR);
RT_MAX = DWORD(RT_MANIFEST);
ResourceTypes: array [RT_MIN..RT_MAX] of PChar = (
'Hardware-dependent cursor',
'Bitmap',
'Hardware-dependent icon',
'Menu',
'Dialog box',
'String-table entry',
'Font directory',
'Font',
'Accelerator table',
'Application-defined resource (raw data)',
'Message-table entry',
'Hardware-independent cursor',
nil, { unknown, reserved or not used }
'Hardware-independent icon',
nil, { unknown, reserved or not used }
'Version',
'Dialog Include',
nil, { unknown, reserved or not used }
'Plug and Play',
'VxD',
'Animated cursor',
'Animated icon',
'HTML resource',
'Side-by-Side Assembly Manifest'
);
Will I get any advantages/disadvantages in rewriting that as case statement? Are there any advantages/disadvantages in leaving that as is?
I think that using an array is the fastest method. If you e.g. query ResourceTypes[2], the program will first look at ResourceTypes[2], dereference the PChar and output the zero terminated string. If the compiler is smart, it could recognize that the strings are unchangeable and so it could place all strings directly in the array, so you would save one dereferencing operation. (For those who are interested in it, can view the memory contents using an hex-editor like HxD to check if this is true or not).
Another problem which might happen in future could be following scenario: Let's say Microsoft defines a new resource type which is something very special, and so it gets a large number like $FFFF . If you are using case of, you can simply add 2 lines of code to add this new resource type. By having a lookup-table (or LUT, this abbreviation is new to me), you would have a problem then, since you would need to create an array with size 65535 whose contents are to 99% just nils.
I would accomplish it by creating a function:
function GetHumanFriendlyResourceTypeName(AResourceType: PChar): string;
begin
if not Is_IntResource(AResourceType) then
begin
result := AResourceType;
end
else
begin
case Integer(AResourceType) of
Integer(RT_CURSOR):
result := 'Hardware-dependent cursor';
Integer(RT_BITMAP):
result := 'Bitmap';
Integer(RT_ICON):
result := 'Hardware-dependent icon';
Integer(RT_MENU):
result := 'Menu';
Integer(RT_DIALOG):
result := 'Dialog box';
Integer(RT_STRING):
result := 'String-table entry';
Integer(RT_FONTDIR):
result := 'Font directory';
Integer(RT_FONT):
result := 'Font';
Integer(RT_ACCELERATOR):
result := 'Accelerator table';
Integer(RT_RCDATA):
result := 'Application-defined resource (raw data)';
Integer(RT_MESSAGETABLE):
result := 'Message-table entry';
Integer(RT_GROUP_CURSOR):
result := 'Hardware-independent cursor';
Integer(RT_GROUP_ICON):
result := 'Hardware-independent icon';
Integer(RT_VERSION):
result := 'Version';
Integer(RT_DLGINCLUDE):
result := 'Dialog Include';
Integer(RT_PLUGPLAY):
result := 'Plug and Play';
Integer(RT_VXD):
result := 'VxD';
Integer(RT_ANICURSOR):
result := 'Animated cursor';
Integer(RT_ANIICON):
result := 'Animated icon';
Integer(RT_HTML):
result := 'HTML resource';
Integer(RT_MANIFEST):
result := 'Side-by-Side Assembly Manifest';
else
result := Format('(Unknown type %d)', [Integer(AResourceType)]);
end;
end;
end;
Here is a demonstration of the code:
procedure TForm1.Button1Click(Sender: TObject);
begin
// Hardware-dependent icon
ShowMessage(GetHumanFriendlyResourceTypeName(MAKEINTRESOURCE(3)));
// (Unknown type 123)
ShowMessage(GetHumanFriendlyResourceTypeName(MAKEINTRESOURCE(123)));
// AVI
ShowMessage(GetHumanFriendlyResourceTypeName(PChar('AVI')));
end;
The performance is not as high as in your solution, but this function has several advantages:
This function is much easier to read since every RT_ constant is standing in front of its human-friendly name. So the code is also much better to maintain. In the LUT, the human-friendly names could be accidently interchanged (also since no comment in front of each human-friendly name indicates the official RT_ constant name).
This function does also show a nice human-friendly string "(Unknown type 123)" if the identifier is unknown.
This function will also dereference the string if it is not a predefined type (RT_)
Using this function you can internationalize your application either statically by putting the strings into resourcestrings or dynamically by querying a translation function/stringlist.

Writing a Scheme interpreter with FPC: Recursive data structures

Essentially, this is a question about recursive data structures in Pascal (FPC). As I would like to implement a Scheme interpreter like it is shown in SICP chapter 4, this question may be relevant for Schemers as well. :)
S-expressions shall be represented as tagged data. So far, I have constructed a variant record, which represents numbers and pairs. Hopefully the code is readable and self-explanatory:
program scheme;
type
TTag = (ScmFixnum, ScmPair);
PScmObject = ^TScmObject;
TScmObject = record
case ScmObjectTag: TTag of
ScmFixnum: (ScmObjectFixnum: integer);
ScmPair: (ScmObjectCar, ScmObjectCdr: PScmObject);
end;
var
Test1: TScmObject;
Test2: TScmObject;
Test3: TScmObject;
function MakeFixnum(x: integer): TScmObject;
var
fixnum: TScmObject;
begin
fixnum.ScmObjectTag := ScmFixnum;
fixnum.ScmObjectFixnum := x;
MakeFixnum := fixnum;
end;
function MakePair(car, cdr: PScmObject): TScmObject;
var
pair: TScmObject;
begin
pair.ScmObjectTag := ScmPair;
pair.ScmObjectCar := car;
pair.ScmObjectCdr := cdr;
MakePair := pair;
end;
begin
Test1 := MakeFixnum(7);
writeln('Test1, Tag: ', Test1.ScmObjectTag,
', Content: ', Test1.ScmObjectFixnum);
Test2 := MakeFixnum(9);
writeln('Test2, Tag: ', Test2.ScmObjectTag,
', Content: ', Test2.ScmObjectFixnum);
Test3 := MakePair(Test1, Test2);
end.
However, compiling the code yields an error as follows:
$ fpc scheme.pas
(...)
Compiling scheme.pas
scheme.pas(43,34) Error: Incompatible type for arg no. 2: Got "TScmObject", expected "PScmObject"
scheme.pas(45) Fatal: There were 1 errors compiling module, stopping
Fatal: Compilation aborted
It is obvious that there is an error in the function MakePair. But I do not understand yet what exactly I am doing wrong. Any help is appreciated. :)
The MakePair function is defined like this:
function MakePair(car, cdr: PScmObject): TScmObject;
Note that it receives two pointers of type PScmObject. You then call it like this:
MakePair(Test1, Test2);
But Test1 and Test2 are of type TScmObject. So the actual parameters passed are not compatible, just as the compiler says.
You need to pass pointers to these records instead:
MakePair(#Test1, #Test2);
In the longer term you are going to need to be careful about the lifetime of these records. You'll need to allocate on the heap and without garbage collection I suspect that you'll enter a world of pain trying to keep track of who owns the records. Perhaps you could consider using interface reference counting to manage lifetime.
The procedure is expecting a pointer to the record, and not the record itself.
You can use the # (at) operator, at the call point, to create a pointer on the fly to the record, and thus satisfy the compiler type check:
begin
Test1 := MakeFixnum(7);
writeln('Test1, Tag: ', Test1.ScmObjectTag,
', Content: ', Test1.ScmObjectFixnum);
Test2 := MakeFixnum(9);
writeln('Test2, Tag: ', Test2.ScmObjectTag,
', Content: ', Test2.ScmObjectFixnum);
Test3 := MakePair(#Test1, #Test2);
end.

Resources