[SOLVED] Generic Linked List in Free Pascal

[skepta]

Hi,

After some trial and error I finally implemented generic linked list in Pascal (objfpc). Please take a look at the attachment for the full code.

Ideally I would like to make the TNode definition like so:

Code: Pascal  [Select][+][-]

1.   generic TNode<_T> = record
2.     Value: _T;
3.     Next: ^TNode<_T>;
4.   end;

Is there any way to achieve this? I prefer to use objfpc if possible.

[ASerge]

There is the GLinkedList unit.

[Thaddy]

In mode Delphi the code compiles fine (3.2.2 and 3.3.1)
This usually means there should be an equivalent in mode objfpc but I can't find it.
In most cases it is the other way around.
Anyway, you can still use it like so:
* one unit with the type declaration in {$mode delphi}

Code: Pascal  [Select][+][-]

1. unit nodedecl;
2. {$mode Delphi}
3. interface
4. uses
5.   Classes, SysUtils;
6. type
7.   TNode<_T> = record
8.     Value: _T;
9.     Next: ^TNode<_T>;
10.   end;
11.  
12. implementation
13. end.

* Your prorgram and other units can now use it in {$mode objfpc} like so:

Code: Pascal  [Select][+][-]

1. program nodedeclaration;
2. {$mode objfpc}
3. uses nodedecl;
4. type
5.   TIntegerNode = specialize TNode<integer>;
6. // or
7. var
8.   node:specialize TNode<integer>;
9.   // or node:TIntegerNode;
10. begin
11. end.

But I really think there must be another way. Anyway, this works.

[dbannon]

skepta, some time ago I bench marked a Linked List against TFPList, both using the same record (a fairly large one). That was a LL of my construction, not a generic on (they are very easy to write). To my surprise, the TFPList was faster, not by a huge margin but well beyond experimental error.

I very much doubt a generic LL would be much faster, probably a touch slower. I had no reliable means to compare memory consumption but, as I said, my record was largish so swamped any difference.

Not as sexy as using generics but easier to understand, write and debug. 

Davo



 

[Warfley]

There are two reasons why TFPList is so fast, the first one is cache locality. Chasing pointers is expensive. The second and more interesting one is geometric growth.

Normally expanding an array requires allocating new memory and copying everything over. Meaning n insertions require O(n²) operations. When using geometric growth you always double the number of allocated elements. So let's say you have an empty list, you add the first element, it starts by allocating space for 4 elements. When adding the 5th element, the space will be doubled to 8 elements, then to 16, etc.

Looking at the runtime, you only need to copy the elements when you do the expansion, in all other cases the runtime is just O(1). So most allocations are practically free. You only have the cost of copying n elements on expansion, which happens every log2(n) steps, which is expensive for that step. But looking at the average runtime over the whole lifetime (Armortized Analysis) you can do the math and end up at O(n).

So looking at each insertion individually, you have a high likelyhood that it is basically free because the memory is already allocated (probability of n/log2(n)). If you have an algorithm doing a lot of insertions in sequence, the total runtime is just O(n).

An additional thing is the warmup, if you have an algorithm that adds a bunch of stuff, removes some, and adds more, most likely it will run into a stable state, where the size of the list does not change anymore, because not enough elements are removed or no more are added. At this point the operations are basically in O(1).

Compared to Linked Lists, where all operations are in O(n), geometricly growing lists have no disadvantage

[Thaddy]

That said, generics of this type have as such no influence on speed if properly aligned.
It is slightly more than a template, but is a replay.
That would lead - theoretically - to the same speed as a manual declaration of a singly linked list as above.
Because the generated code should be the same.

[dbannon]

It is slightly more than a template, but is a replay.

But Thaddy, and I'd like you to be able to tell me I am wrong, that "replay" happens at run time, not at compile time. So, a small  delay at startup every time it runs. I know each one is insignificant but they add up. Coding a LL is a first year prac, if you want something richer (or faster) TFPList rocks !

(Maybe, just maybe, if there was more concentration on a release program instead of things like generics, we'd look just a bit more credible ?)
 
Davo

[Thaddy]

@dbannon

Nope, replay occurs at compile time. It is not an rtti based feature if you thought so.
I will add some assembler output later.
The generated code is identical:

Code: Pascal  [Select][+][-]

1. program intvsgeneric;
2. {$mode delphi}{$I-}
3. type
4.   TNode<_T> = record
5.     Value: _T;
6.     Next: ^TNode<_T>;
7.   end;
8.  
9.   TGenericIntegerNode = TNode<integer>; //compile time specialization as type
10.  
11.   TPureIntegerNode = record
12.     value:integer;
13.     Next:PInteger;
14.   end;
15.  
16. var
17.   a:TGenericIntegerNode;
18.   b:TPureIntegerNode;  
19.   c:TNode<integer> // compile time spec as var
20. begin
21.   a.value := 100;
22.   b.value := 200;
23.   c.value := 300;
24.   writeln(a.value);
25.   writeln(b.value);
26.   writeln(c.value);
27. end.

Renders:

Code: ASM  [Select][+][-]

1. # [20] a.value := 100;
2.         movl    $100,U_$P$INTVSGENERIC_$$_A(%rip)
3. .Ll3:
4. # [21] b.value := 200;
5.         movl    $200,U_$P$INTVSGENERIC_$$_B(%rip)
6. .Ll4:
7. # [22] c.value := 300;
8.         movl    $300,U_$P$INTVSGENERIC_$$_C(%rip)
9. .Ll5:
10. # [23] writeln(a.value);
11.         call    fpc_get_output
12.         movq    %rax,%rbx
13.         movslq  U_$P$INTVSGENERIC_$$_A(%rip),%r8
14.         movq    %rax,%rdx
15.         xorl    %ecx,%ecx
16.         call    fpc_write_text_sint
17.         movq    %rbx,%rcx
18.         call    fpc_writeln_end
19. .Ll6:
20. # [24] writeln(b.value);
21.         call    fpc_get_output
22.         movq    %rax,%rbx
23.         movslq  U_$P$INTVSGENERIC_$$_B(%rip),%r8
24.         movq    %rax,%rdx
25.         xorl    %ecx,%ecx
26.         call    fpc_write_text_sint
27.         movq    %rbx,%rcx
28.         call    fpc_writeln_end
29. .Ll7:
30. # [25] writeln(c.value);
31.         call    fpc_get_output
32.         movq    %rax,%rbx
33.         movslq  U_$P$INTVSGENERIC_$$_C(%rip),%r8
34.         movq    %rax,%rdx
35.         xorl    %ecx,%ecx
36.         call    fpc_write_text_sint
37.         movq    %rbx,%rcx
38.         call    fpc_writeln_end
39. .Ll8:
40. # [26] end.
41.         call    fpc_do_exit
42. .seh_endproc
43. .Lc1:
44. .Lt1:
45. .Ll9:
46.  
47. .section .fpc.n_links,"aw"
48.         .quad   DEBUGSTART_$P$INTVSGENERIC
49.         .quad   DEBUGEND_$P$INTVSGENERIC
50. # End asmlist al_procedures
51. # Begin asmlist al_globals
52.  
53. .section .bss,"aw"
54.         .balign 8
55. # [16] a:TGenericIntegerNode;
56.         .globl U_$P$INTVSGENERIC_$$_A
57. U_$P$INTVSGENERIC_$$_A:
58.         .zero 16
59.  
60. .section .bss,"aw"
61.         .balign 8
62. # [17] b:TPureIntegerNode;
63.         .globl U_$P$INTVSGENERIC_$$_B
64. U_$P$INTVSGENERIC_$$_B:
65.         .zero 16
66.  
67. .section .bss,"aw"
68.         .balign 8
69. # [18] c:TNode<integer>;
70.         .globl U_$P$INTVSGENERIC_$$_C
71. U_$P$INTVSGENERIC_$$_C:
72.         .zero 16
73.  

And that confirms my statement that generics code can be just as fast as normal code and more often than not even generates the exact same code. Well written generics code has no speed penalty.
This is a simple example, but only for brevity. More complex examples behave the same, though.
E.g. a completed example of a generic singly linked list.

Seems you misunderstood the way it works, hope this enlightens you. 

[d2010]

Hi,
After some trial and error I finally implemented generic linked list in Pascal (objfpc). Please take a look at the attachment for the full code.

My solution, I tested, but  iose   my sense , of too many variabiles in , after the public.
You can replace i,j:word with string, shortstring, double, comp or Other.

Code: Pascal  [Select][+][-]

1. Type _ct2word=record i,j:word;end;{implementarea stivelor pentru 2 word}
2.      _ct_wordlist=^_ct_wordlist_noP;
3.      _ct_wordlist_noP=record
4.                     c:_ct2word;
5.                     pred,urm:_ct_wordlist;
6.                    end;
7.  
8.     _cstack_2word=object {implemetarea stivei pentru C,elementul de baza este 2 words}
9.    Function  find(c1:_ct2word):_ct_wordlist;
10.    Procedure append(c:_ct2word);
11.    Function  appendifnot(c:_ct2word):integer;
12.    Procedure insert(mode:_tAi_insert_mode;c,c2:_ct2word);
13.    function  delete(c:_ct2word):integer;
14.    procedure view;{dela inceput la sfarsit}
15.    procedure view2;{dela sfarsit la inceput}
16.    Procedure init;
17.    Procedure delete_all;
18.    Function  update(c,c2:_ct2word):integer;
19.    Public  ms1,ms2,mp,mq:_ct_wordlist;
20.            p1,p2:word;
21.            End;
22.  

For testing I create a small Menu
Begin clrscr;

Code: [Select]

  {$X+}
Uses cstack,crt,strings;
Var c:char;a1,a2:_ct2word;
    ai:_cstack_2word;
Function menu:char;
Begin clrscr;
      writeln('  ***  Test Stack/List 2Words: ***');
      writeln('      1=insert before 2words');
      writeln('      2=insert after 2words');
      writeln('      3=append list');
      writeln('      4=delete 2words');
      writeln('      5=delete all 2words');
      writeln('      6=view top-bottom list');
      writeln('      7=view bottom-top list');
      writeln('      8=update 2words');
      writeln('      9=append if');
      writeln('      0=exit');
      Writeln;
      Writeln;
      Writeln('sizeof(ai)=',sizeof(ai));
      Writeln('sizeof(p1)=',sizeof(a1));
      repeat c:=readkey;until c in ['0'..'A'];
      write(c);
      menu:=c;

End;
Begin
       ai.init;
       repeat
       menu;clrscr;
       case c of
       '1'..'2':Begin write('Insert ');
                      if c='1' then write('before') else write('after');
                      write(' words:');read(a1.i);read(a1.j);
                      write(#13#10,'What insert?:');read(a2.i);read(a2.j);
                      if c='1' then ai.insert(before,a1,a2)
                               else ai.insert(after,a1,a2);

               End;{1.2}
      '3':Begin clrscr;
                Writeln('Input "0,0"=exit');
                repeat
                   Write(#13#10,'Append:');read(a1.i);read(a1.j);
                   if (a1.i<>0)and(a1.j<>0) then ai.append(a1);
                until (a1.i=0)and(a1.j=0) ;
           End;{3}
      '4':Begin write(#13#10,'Deleting words :');
                read(a1.i);read(a1.j);
                if ai.delete(a1)=-1 then writeln('Not Found ');
           end;
      '5':Begin writeln('Delete all..');ai.delete_all;end;
      '6':Begin writeln('View top->bottom');ai.view;end;
      '7':Begin writeln('View bottom->top');ai.view2;end;
      '8':Begin writeln('Update words:');read(a1.i);write(',');read(a1.j);
                write('With words:');read(a2.i);write(',');read(a2.j);
                if ai.update(a1,a2)=-1 then begin writeln('Not Found ');end;
          End;{8}
      '9':Begin write(#13#10,'Append if not:');read(a1.i);write(',');read(a1.j);
                if ai.appendifnot(a1)=-1 then  writeln('-1 already Found ')
                                          else writeln('0  append')

          End;{8}

      end;{case}
     readkey;
     until c='0';
{     dispose(a1);
     dispose(a2);}
End.

Unit cstack;
Interface
Type _ct2word=record i,j:word;end;{implementarea stivelor pentru 2 word}
     _ct_wordlist=^_ct_wordlist_noP;
     _ct_wordlist_noP=record
                    c:_ct2word;
                    pred,urm:_ct_wordlist;
                   end;

    _cstack_2word=object {implemetarea stivei pentru C,elementul de baza este 2 words}
   Function  find(c1:_ct2word):_ct_wordlist;
   Procedure append(c:_ct2word);
   Function  appendifnot(c:_ct2word):integer;
   Procedure insert(mode:_tAi_insert_mode;c,c2:_ct2word);
   function  delete(c:_ct2word):integer;
   procedure view;{dela inceput la sfarsit}
   procedure view2;{dela sfarsit la inceput}
   Procedure init;
   Procedure delete_all;
   Function  update(c,c2:_ct2word):integer;
   Public  ms1,ms2,mp,mq:_ct_wordlist;
           p1,p2:word;
           End;
Implementation
Function _cstack_2word.find(c1:_ct2word):_ct_wordlist;
Var p:_ct_wordlist;
Begin ms2^.c:=c1;
      p:=ms1^.urm;
      While not((p^.c.i=c1.i)and(p^.c.j=c1.j)) do
      Begin  p:=p^.urm;
     End;
      find:=p;
End;
Procedure _cstack_2word.append(c:_ct2word);
Begin mp:=ms2;
      new(ms2);
      mp^.urm:=ms2;mp^.c:=c;
      ms2^.pred:=mp;
End;
{returneaza 0 ok
            -1 already exist}
Function _cstack_2word.appendifnot(c:_ct2word):integer;
Begin if find(c)=ms2 then begin append(c);appendifnot:=0;end
                      else appendifnot:=-1;
End;
Procedure _cstack_2word.insert(mode:_tAi_insert_mode;c,c2:_ct2word);
Begin  case mode of
   after:Begin mp:=find(c);
               if mp=ms2 then append(c2)
                         else begin new(mq);with mq^ do begin
                                    c:=c2;urm:=mp^.urm;pred:=mp;end;
                                    mp^.urm^.pred:=mq;
                                    mp^.urm:=mq;
                              end;{else}

         End;{..after}
  before:Begin mp:=find(c);
               if mp=ms2 then append(c2)
                         else begin new(mq);with mq^ do begin c:=c2;pred:=mp^.pred;urm:=mp;end;
                                    mp^.pred^.urm:=mq;
                                    mp^.pred:=mq;
                             end;{else}
         End;{..after}
        end;{case}

End;
{returneaza -1 not found
            0 found}
Function _cstack_2word.delete(c:_ct2word):integer;
Begin mp:=find(c);
      if mp=ms2 then delete:=-1
                else begin mp^.pred^.urm:=mp^.urm;
                           mp^.urm^.pred:=mp^.pred;
                           dispose(mp);
                     end;{else}
{    dispose(c);}
End;
Procedure _cstack_2word.init;
Begin new(ms2);new(ms1);ms1^.urm:=ms2;ms2^.pred:=ms1;
End;
procedure _cstack_2word.view;
Begin mp:=ms1^.urm;
      if mp=ms2 then writeln('Lista Vida')
                else begin repeat writeln(mp^.c.i,',',mp^.c.j);
                                   mp:=mp^.urm;until mp=ms2;
                     end;
End;
procedure _cstack_2word.view2;
Begin mp:=ms2^.pred;
      if mp=ms1 then writeln('Lista Vida')
                else begin repeat writeln(mp^.c.i,',',mp^.c.j);mp:=mp^.pred;until mp=ms1;
                     end;
End;
Procedure _cstack_2word.delete_all;
Begin mp:=ms1^.urm;
      if mp<>ms2 then
       Begin   repeat dispose(mp^.pred);{dispose(mp^.c);}
                      mp:=mp^.urm;
               until mp=ms2;
               _cstack_2word.init;
        End;
End;
Function  _cstack_2word.update(c,c2:_ct2word):integer;
Begin mp:=find(c);
      if mp=ms2 then update:=-1
                else begin mp^.c:=c2;update:=0;end;
End;
Begin
End.


[marcov]

Compared to Linked Lists, where all operations are in O(n), geometricly growing lists have no disadvantage

Make them ordered and retest :-)

[PascalDragon]

Ideally I would like to make the TNode definition like so:

Code: Pascal  [Select][+][-]

1.   generic TNode<_T> = record
2.     Value: _T;
3.     Next: ^TNode<_T>;
4.   end;

Is there any way to achieve this? I prefer to use objfpc if possible.

Just use specialize where it belongs?

Code: Pascal  [Select][+][-]

1. type
2.   generic TNode<T> = record
3.     Value: T;
4.     Next: ^specialize TNode<T>;
5.   end;

[avk]

Ideally I would like to make the TNode definition like so:

Code: Pascal  [Select][+][-]

1.   generic TNode<_T> = record
2.     Value: _T;
3.     Next: ^TNode<_T>;
4.   end;

Is there any way to achieve this? I prefer to use objfpc if possible.

Just use specialize where it belongs?

Code: Pascal  [Select][+][-]

1. type
2.   generic TNode<T> = record
3.     Value: T;
4.     Next: ^specialize TNode<T>;
5.   end;

But why not just

Code: Pascal  [Select][+][-]

1.   generic TNode<T> = record
2.     Value: T;
3.     Next: ^TNode;
4.   end;
5.  

?

[Thaddy]

With PascalDragon's code in objfpc mode I get an internal error.
intvsgeneric.pas(6,28) Fatal: Internal error 2019112401

[dbannon]

Nope, replay occurs at compile time. It is not an rtti based feature if you thought so.
I will add some assembler output later.
The generated code is identical:

OK Thaddy, I've told you in the past I have not used assembler since 2nd Year Uni (a long time ago) but even I can see what you show is identical. (Nothing in the "initialise" for lack of a better word, section ?). Anyway, I accept its possibly, even probably as good as hand coded. Mind you, hand coded is always as good as hand coded 

Thanks for clarifying my misconceptions !

Davo

[bytebites]

With PascalDragon's code in objfpc mode I get an internal error.
intvsgeneric.pas(6,28) Fatal: Internal error 2019112401

It compiles with {$ModeSwitch advancedrecords}