Writing a Scheme interpreter with FPC: Recursive data structures - delphi

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.

Related

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.

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.

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.

Delphi, FastReport params

I have a problem with printing
procedure Sendparams(const Pparams,pparvalues :array of string);
begin
for I := 0 to Length(Pparams) - 1 do
begin
lpar_name:=Pparams[i];
lpar_val:=pparvalues[i] ;
FfrxReport.Variables.AddVariable('Bez', lpar_name, lpar_val);
end;
Sendparams(['buyer','delivery'], ['buyer address', 'delivery address']);
Everything works fine until I try to print report; it says: Expression expected on Memo2.
Memo1.memo = '[buyer]';
Memo2.memo = '[delivery]';
memo1 and memo2 all other properties are the same. Any suggestions?
There are different possible traps.
If you want to use Addvariable (instead of variables.add) the category, in your case Bez has to be defined in the report, otherwise the variables won't be add. **
The assignment of the variables within the report hast to look like Memo1.Lines.Text :=<buyer>;
You will have to quote the string values of the variables
Sendparams(['buyer','delivery'], [QuotedStr('buyer address'), QuotedStr('delivery address')]);
**
Another attempt could be something like this, to avoid open arrays of string (where count of names and values accidentally could differ), to avoid a hard reference to the report within Sendparams and to deal with variables which already could be defined within the report.
Function PrepareReport(Report:TfrxReport; Variables: TfrxVariables;
ReportName: String):Boolean;// -- other parameters
var
i,k:Integer;
begin
// ....... other initializations
if Assigned(Variables) then
for i := 0 to Variables.Count - 1 do
begin
k := Report.Variables.IndexOf(Variables.Items[i].Name);
if k > -1 then
Report.Variables.Items[k].Value := Variables.Items[i].Value
else
begin
with Report.Variables.Add do
begin
Name := Variables.Items[i].Name;
Value := Variables.Items[i].Value;
end;
end;
end;
end;

Error "Record, object or class type required" when using a wrapper type of an array

I have got two arapper types for easy handling /returning of one-dimensional Arrays, and I want so write a method to convert one to another (a 2d-float-Vector class to a 2d-int-point class). Wrote a simple one, but it just throws some errors I donĀ“t understand.
unit UUtil;
interface
uses
UVector2f, Types, SysUtils;
type
Vector2fArrayWrapper = array of Vector2f;
PointArrayWrapper = array of TPoint;
implementation
function toPointArray(vw : Vector2fArrayWrapper) : PointArrayWrapper;
var pw : PointArrayWrapper;
i,x,y : Integer;
begin
setLength(pw, vw.length);
for i := 0 to vw.high do
begin
x := round(vw[i].getX());
y := round(vw[i].getY());
vw[i] := TPoint(x,y);
end;
result := pw;
end;
end.
These are the errors I get:
[Error] UUtil.pas(20): Record, object or class type required
[Error] UUtil.pas(21): Record, object or class type required
[Error] UUtil.pas(25): ')' expected but ',' found
[Error] UUtil.pas(27): Declaration expected but identifier 'result' found
[Error] UUtil.pas(28): '.' expected but ';' found
Dynamic arrays are not objects, classes or records. They do not have methods defined on them.
Instead of
vw.length
you must write
Length(vw)
And likewise for high.
Next up, TPoint is a type. If you want to make a new one, you use the helper function Point().
Then you assign to vw[i], but surely you mean to assign to pw[i].
Finally, there's no need to introduce a local variable, and then assign Result that local variable. You can do all the work directly on Result. So, I'd write the code like this:
function toPointArray(const vw: Vector2fArrayWrapper): PointArrayWrapper;
var
i: Integer;
begin
setLength( Result, Length(vw));
for i := 0 to high(vw) do
Result[i] := Point(round(vw[i].getX), round(vw[i].getY));
end;

Resources