On 04/05/17 22:30, Sven Barth via fpc-pascal wrote:
Hello together!
Since revision 36105 FPC now supports the use of array constructorsusing the 
"[...]" syntax inside ordinary code blocks like Delphi doessince - I think - 
XE8. And yes, even nested ones are supported (take alook at 
$fpcdir/tests/test/tarrconstr5.pp for a bit of inspiration).
Considering that this changed how "[...]" is handled I'd like you all totest 
whether your existing code still works (especially if it's dealingwith sets!) and to try 
this new feature to see if there are any problemsthat our testsuite doesn't cover yet.
If you report bugs, then please attach the tag "array constructors".

Ah yes, /very/ nice :-)

I append a chunk of fun code, which as it stands needs separate functions per rank (i.e. for 1 dimension, 2 dimensions and so on). Can these be rationalised using generics?

Output should look something like

a3:
1 2 3 4 5
1 2 3 4 5
1 2 3 4 5

5 6 7 8 9
1 3 5 7 9
2 4 6 8 0


+/ a3:
6 8 10 12 14
2 5 8 11 14
3 6 9 12 5


a2:
6 8 10 12 14
2 5 8 11 14
3 6 9 12 5

+/ a2:
11 19 27 35 33


a1:
11 19 27 35 33
+/ a1:
125

--
Mark Morgan Lloyd
markMLl .AT. telemetry.co .DOT. uk

[Opinions above are the author's, not those of his employers or colleagues]




program testReduction;

{$mode objfpc}{$H+}

// This demo program abuses FPC's custom operator facility to simulate
// Vector Pascal's \+ (reduce-add) operator, which is derived from APL's
// +/ function/operator.

// It's reasonable to expect no sane code to try to attempt to add a
// procedure to an array or a number.

type     TReduce= procedure(p1: pointer);

const    Reduce: TReduce= nil;

type    t1= array of longint;
        t2= array of t1;
        t3= array of t2;

{$MACRO ON}
{$DEFINE SHOW_IDENTITY:=// WriteLn('Identity:'); print(result); WriteLn; }


procedure print(i: longint);

begin
  Write(i)
end { print } ;


procedure print(const a: t1);

var     i: integer;

begin
  for i := Low(a) to High(a) do
    Write(a[i], ' ');
  WriteLn
end { print } ;


procedure print(const a: t2);

var     i: integer;

begin
  for i := Low(a) to High(a) do
    print(a[i]);
  WriteLn
end { print } ;


procedure print(const a: t3);

var     i: integer;

begin
  for i := Low(a) to High(a) do
    print(a[i]);
//  WriteLn('-----');
  WriteLn
end { print } ;


operator + (const a1, a2: t1): t1;

var     i: integer;

begin
  SetLength(result, Length(a1));
  for i := Low(a1) to High(a1) do
    result[i] := a1[i] + a2[i]
end { + } ;


operator + (const a1, a2: t2): t2;

var     i: integer;

begin
  SetLength(result, Length(a1));
  for i := Low(a1) to High(a1) do
    result[i] := a1[i] + a2[i]
end { + } ;


const    additiveIdentity= 0;
         multiplicativeIdentity= 1;


operator + (const r: TReduce; const a: t1): longint;

var     i: integer;

begin
  result := additiveIdentity;
  SHOW_IDENTITY
  for i := Low(a) to High(a) do
    result += a[i]
end { + } ;


operator + (const r: TReduce; const a: t2): t1;

var     i: integer;

begin
  SetLength(result, Length(a[Low(a)]));
  for i := Low(result) to High(result) do
    result[i] := additiveIdentity;
  SHOW_IDENTITY
  for i := Low(a) to High(a) do
    result += a[i]
end { + } ;


operator + (const r: TReduce; const a: t3): t2;

var     i: integer;


  function additiveIdentityArray1: t1;

  var   i: integer;

  begin
    SetLength(result, Length(a[0, 0]));
    for i := Low(result) to High(result) do
      result[i] := additiveIdentity
  end { additiveIdentityArray1 } ;


begin
  SetLength(result, Length(a[Low(a)]));
  for i := Low(result) to High(result) do
    result[i] := additiveIdentityArray1;
  SHOW_IDENTITY
  for i := Low(a) to High(a) do begin
    result += a[i]
  end
end { + } ;


var      a0: longint;
         a1: t1;
         a2: t2;
         a3: t3;

begin
  a3 := [[[1,2,3,4,5],[1,2,3,4,5],[1,2,3,4,5]],
         [[5,6,7,8,9],[1,3,5,7,9],[2,4,6,8,0]]];
  WriteLn('a3:');
  print(a3);
  WriteLn('+/ a3:');
  a2 := reduce + a3;
  print(a2); WriteLn;

  WriteLn('a2:');
  print(a2);
  WriteLn('+/ a2:');
  a1 := reduce + a2;
  print(a1); WriteLn;
  WriteLn;

  WriteLn('a1:');
  print(a1);
  WriteLn('+/ a1:');
  a0 := reduce + a1;
  WriteLn(a0);
  WriteLn
end.




_______________________________________________
fpc-pascal maillist  -  fpc-pascal@lists.freepascal.org
http://lists.freepascal.org/cgi-bin/mailman/listinfo/fpc-pascal

Reply via email to