Properties in arrays possible?
lazarus / 62-General

----------------------------------------------------------------------
trn76 · 2014-04-24 19:11

I use alot of records, and love that FPC supports functions and
properties inside them.
But is the same possible with arrays?

Code: [Select]  // record with functions and properties, love them :)
  PTestInt              = ^TTestInt;
  TTestInt              = record
    private
      function          getAreal: integer; inline;
    public
      x                 : integer;
      y                 : integer;
      property          Areal: integer read getAreal;
  end;

  // wish i could add functions/properties directly in the array here:
  TTestIntPArray        = array of PTestInt;
  // if so... i could for example have a function that sums the total
area of all the array items


.....
implementation

  function TTestInt.getAreal: integer;
  begin
    Result := x * y;
  end;

----------------------------------------------------------------------
Blaazen · 2014-04-24 20:36

This code compiles in {$mode delphi} and fpc 2.7.1 (trunk):
Code: [Select]unit Unit1;                    
{$mode delphi}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs;

type
  TArr = record
    Items: array of Integer;
  end;
 
  TAH = record helper for TArr
    procedure Lalala; 
  end;
 
  TForm1 = class(TForm)
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

procedure TAH.Lalala;
begin
  writeln(Length(Items));
end;

{$R *.lfm}

end.
Do this directly for array is probably impossible.

----------------------------------------------------------------------
trn76 · 2014-04-24 21:46

Ohh happy! 
I've done some testing, and it seems like I can atleast make it behave
like I want to.
Some pretty useless records here, but they work as almost I hoped.

Code: [Select]  PTestInt              = ^TTestInt;
  TTestInt              = record
    private
      function          getAreal: integer;
    public
      x                 : integer;
      y                 : integer;
      property          Areal: integer read getAreal;
  end;

  TTestIntList          = record
    private
      function          getArealTotal: integer;
      function          getItem(Index: integer): PTestInt; inline;
      procedure         setItem(Index: integer; AValue: PTestInt);
inline;
    public
      Items             : array of PTestInt;
      property          ArealTotal: integer read getArealTotal;
      property          Int[Index: integer]: PTestInt read getItem
write setItem; default;
  end;
....
implementation

function TTestIntList.getArealTotal: integer;
var i: integer;
begin
  Result := 0;
  for i := 0 to Length(Items)-1 do
    Result += Items[i]^.Areal;
end;

function TTestIntList.getItem(Index: integer): PTestInt;
begin
  Result := Items[Index];
end;

procedure TTestIntList.setItem(Index: integer; AValue: PTestInt);
begin
  Items[Index]:= AValue;
end;

function TTestInt.getAreal: integer;
begin
  Result := x * y;
end;

procedure testStuff;
var i, c: integer;
begin

  c := 100;
  SetLength(test.Items, c);
  for i := 0 to c-1 do
    New(test.Items[i]);

  for i := 0 to 5 do
    test[i]^.x := i;

  for i := 0 to 5 do
    test.Items[i]^.x := i;

  for i := 1 to 5 do
    test[i]^.x := test[c-i]^.x;

  for i := 1 to 5 do
    test.Items[i]^.x := test.Items[c-i]^.x;

  i := 0;
end;


And looking at the asm output (optimized level 2, all checks off):
Code: [Select]ugtexture_packer.pas:498          c := 100;
004262F3 b864000000               mov    $0x64,%eax
ugtexture_packer.pas:499          SetLength(test.Items, c);
004262F8 8945b4                   mov    %eax,-0x4c(%ebp)
004262FB 8945cc                   mov    %eax,-0x34(%ebp)
004262FE 8d45cc                   lea    -0x34(%ebp),%eax
00426301 50                       push   %eax
00426302 ba5c195500               mov    $0x55195c,%edx
00426307 8d45f8                   lea    -0x8(%ebp),%eax
0042630A b901000000               mov    $0x1,%ecx
0042630F e87c40feff               call   0x40a390
<fpc_dynarray_setlength>

ugtexture_packer.pas:500          for i := 0 to c-1 do
00426314 8b45b4                   mov    -0x4c(%ebp),%eax
00426317 48                       dec    %eax
00426318 89c3                     mov    %eax,%ebx
0042631A c745b000000000           movl   $0x0,-0x50(%ebp)
00426321 3b5db0                   cmp    -0x50(%ebp),%ebx
00426324 7c21                     jl     0x426347
<TTEXTUREPACKERSHELF__PACKTEXTURES+167>
00426326 ff4db0                   decl   -0x50(%ebp)
00426329 8d7600                   lea    0x0(%esi),%esi
0042632C ff45b0                   incl   -0x50(%ebp)

ugtexture_packer.pas:501          New(test.Items[i]);
0042632F b808000000               mov    $0x8,%eax
00426334 e80773feff               call   0x40d640 <fpc_getmem>
00426339 8b4df8                   mov    -0x8(%ebp),%ecx
0042633C 8b55b0                   mov    -0x50(%ebp),%edx
0042633F 890491                   mov    %eax,(%ecx,%edx,4)
00426342 3b5db0                   cmp    -0x50(%ebp),%ebx
00426345 7fe5                     jg     0x42632c
<TTEXTUREPACKERSHELF__PACKTEXTURES+140>

ugtexture_packer.pas:503          for i := 0 to 5 do
00426347 c745b000000000           movl   $0x0,-0x50(%ebp)
0042634E ff4db0                   decl   -0x50(%ebp)
00426351 8d7600                   lea    0x0(%esi),%esi
00426354 ff45b0                   incl   -0x50(%ebp)

ugtexture_packer.pas:504          test[i]^.x := i;
00426357 8b45b0                   mov    -0x50(%ebp),%eax
0042635A 8b55f8                   mov    -0x8(%ebp),%edx
0042635D 8b0482                   mov    (%edx,%eax,4),%eax
00426360 8b55b0                   mov    -0x50(%ebp),%edx
00426363 8910                     mov    %edx,(%eax)
00426365 837db005                 cmpl   $0x5,-0x50(%ebp)
00426369 7ce9                     jl     0x426354
<TTEXTUREPACKERSHELF__PACKTEXTURES+180>

ugtexture_packer.pas:506          for i := 0 to 5 do
0042636B c745b000000000           movl   $0x0,-0x50(%ebp)
00426372 ff4db0                   decl   -0x50(%ebp)
00426375 8d7600                   lea    0x0(%esi),%esi
00426378 ff45b0                   incl   -0x50(%ebp)

ugtexture_packer.pas:507          test.Items[i]^.x := i;
0042637B 8b45f8                   mov    -0x8(%ebp),%eax
0042637E 8b55b0                   mov    -0x50(%ebp),%edx
00426381 8b0c90                   mov    (%eax,%edx,4),%ecx
00426384 8b45b0                   mov    -0x50(%ebp),%eax
00426387 8901                     mov    %eax,(%ecx)
00426389 837db005                 cmpl   $0x5,-0x50(%ebp)
0042638D 7ce9                     jl     0x426378
<TTEXTUREPACKERSHELF__PACKTEXTURES+216>

ugtexture_packer.pas:509          for i := 1 to 5 do
0042638F c745b001000000           movl   $0x1,-0x50(%ebp)
00426396 ff4db0                   decl   -0x50(%ebp)
00426399 8d7600                   lea    0x0(%esi),%esi
0042639C ff45b0                   incl   -0x50(%ebp)

ugtexture_packer.pas:510          test[i]^.x := test[c-i]^.x;
0042639F 8b45b4                   mov    -0x4c(%ebp),%eax
004263A2 2b45b0                   sub    -0x50(%ebp),%eax
004263A5 89c2                     mov    %eax,%edx
004263A7 8b45f8                   mov    -0x8(%ebp),%eax
004263AA 8b0c90                   mov    (%eax,%edx,4),%ecx
004263AD 8b55b0                   mov    -0x50(%ebp),%edx
004263B0 8b45f8                   mov    -0x8(%ebp),%eax
004263B3 8b1490                   mov    (%eax,%edx,4),%edx
004263B6 8b01                     mov    (%ecx),%eax
004263B8 8902                     mov    %eax,(%edx)
004263BA 837db005                 cmpl   $0x5,-0x50(%ebp)
004263BE 7cdc                     jl     0x42639c
<TTEXTUREPACKERSHELF__PACKTEXTURES+252>

ugtexture_packer.pas:512          for i := 1 to 5 do
004263C0 c745b001000000           movl   $0x1,-0x50(%ebp)
004263C7 ff4db0                   decl   -0x50(%ebp)
004263CA 89f6                     mov    %esi,%esi
004263CC ff45b0                   incl   -0x50(%ebp)

ugtexture_packer.pas:513          test.Items[i]^.x :=
test.Items[c-i]^.x;
004263CF 8b55f8                   mov    -0x8(%ebp),%edx
004263D2 8b45b4                   mov    -0x4c(%ebp),%eax
004263D5 2b45b0                   sub    -0x50(%ebp),%eax
004263D8 8b0c82                   mov    (%edx,%eax,4),%ecx
004263DB 8b45f8                   mov    -0x8(%ebp),%eax
004263DE 8b55b0                   mov    -0x50(%ebp),%edx
004263E1 8b1c90                   mov    (%eax,%edx,4),%ebx
004263E4 8b01                     mov    (%ecx),%eax
004263E6 8903                     mov    %eax,(%ebx)
004263E8 837db005                 cmpl   $0x5,-0x50(%ebp)
004263EC 7cde                     jl     0x4263cc
<TTEXTUREPACKERSHELF__PACKTEXTURES+300>

ugtexture_packer.pas:515          i := 0;
004263EE c745b000000000           movl   $0x0,-0x50(%ebp)


It seems like the compiler generates the same code when I use the
TTestIntList.getItem (using clamps []), BUT when writing using [] it
looks like the compiler has a little bit more overhead....
Look at asm part test^.x := i; and test.Items^.x := i; <- they output
the same code.
But test^.x := test[c-i]^.x; and test.Items^.x := test.Items[c-i]^.x;
are slightly different.
Wonder why :\
...Am I missing something?

But it was a happy surprice to see it have almost no difference at
all... bye bye arrays and hello records (for stuff like this atleast).

----------------------------------------------------------------------
howardpc · 2014-04-24 21:52

This also compiles in {$mode objfpc}

Code: [Select]unit mainAdvancedRecords;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

interface

uses
  Forms, Dialogs;

type

  TTestInt = record
  private
    function GetArea: int64; inline;
  public
    x: integer;
    y: integer;
    property Area: int64 read GetArea;
  end;

  PTestInt = ^TTestInt;
  TTestIntPArray = array of PTestInt;

  TAreaArray = record
  private
    function  GetTotalArea: int64; inline;
  public
    areaArray: TTestIntPArray;
    property TotalArea: int64 read GetTotalArea;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FAreaArray: TAreaArray;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
const
  ArrayLength = 100;
var
  testArray: TTestIntPArray;
  i: Integer;
begin
  SetLength(testArray, ArrayLength);
  for i := 0 to ArrayLength-1 do begin
    GetMem(testArray[i], SizeOf(TTestInt));
    testArray[i]^.x:=i+1;
    testArray[i]^.y:=i+1;
  end;
  FAreaArray.areaArray:=testArray;

  ShowMessageFmt('Total areas sum to %d',[FAreaArray.TotalArea]);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i:= 0 to length(FAreaArray.areaArray)-1 do
    if FAreaArray.areaArray[i]<>nil then
      Freemem(FAreaArray.areaArray[i]);
end;

{ TAreaArray }

function TAreaArray.GetTotalArea: int64;
var
  i: Integer;
begin
  Result:=0;
  for i:= 0 to Length(areaArray)-1 do
    Inc(Result, areaArray[i]^.getArea);
end;

{ TTestInt }

function TTestInt.GetArea: int64;
begin
  Result:=x*y;
end;

end.

----------------------------------------------------------------------
trn76 · 2014-04-24 22:07

Quote from: howardpc on April 24, 2014, 11:52:23 pmThis also compiles
in {$mode objfpc}

Code: [Select]unit mainAdvancedRecords;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

interface

uses
  Forms, Dialogs;

type

  TTestInt = record
  private
    function GetArea: int64; inline;
  public
    x: integer;
    y: integer;
    property Area: int64 read GetArea;
  end;

  PTestInt = ^TTestInt;
  TTestIntPArray = array of PTestInt;

  TAreaArray = record
  private
    function  GetTotalArea: int64; inline;
  public
    areaArray: TTestIntPArray;
    property TotalArea: int64 read GetTotalArea;
  end;

  { TForm1 }

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    FAreaArray: TAreaArray;
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
const
  ArrayLength = 100;
var
  testArray: TTestIntPArray;
  i: Integer;
begin
  SetLength(testArray, ArrayLength);
  for i := 0 to ArrayLength-1 do begin
    GetMem(testArray[i], SizeOf(TTestInt));
    testArray[i]^.x:=i+1;
    testArray[i]^.y:=i+1;
  end;
  FAreaArray.areaArray:=testArray;

  ShowMessageFmt('Total areas sum to %d',[FAreaArray.TotalArea]);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i:= 0 to length(FAreaArray.areaArray)-1 do
    if FAreaArray.areaArray[i]<>nil then
      Freemem(FAreaArray.areaArray[i]);
end;

{ TAreaArray }

function TAreaArray.GetTotalArea: int64;
var
  i: Integer;
begin
  Result:=0;
  for i:= 0 to Length(areaArray)-1 do
    Inc(Result, areaArray[i]^.getArea);
end;

{ TTestInt }

function TTestInt.GetArea: int64;
begin
  Result:=x*y;
end;

end.


Yeah, but I also wanted to type less!   no kidding... there can be
hard to read sometimes - that is why I also was curious of how it
would compile a record with properties Default and clamps [] - since
it will be using functions to retrieve and write data to the
records... even though it seems like some overhead when writing data.
And I was curious about speed, since array are the fastest way of
accessing data (and like I tested now, it seems like FPC compiles
well) - also why I avoid classes when possible, too much overhead.

----------------------------------------------------------------------
Martin_fr · 2014-04-24 22:54

fpc rtunk:
http://wiki.freepascal.org/FPC_New_Features_Trunk#Support_for_type_hel
pers


Code: [Select]{$modeswitch typehelpers}
....

  TFoo = array of Integer;

  TFooHelper = type helper for TFoo
    procedure Lalala;
  end;

----------------------------------------------------------------------
Blaazen · 2014-04-25 06:31

Thanks, Martin,
I remembered vaguely this info from Sven Barth on the FPC mailing list
but I forgot about the switch.