home *** CD-ROM | disk | FTP | other *** search
/ Mega Top 1 / os2_top1.zip / os2_top1 / APPS / TEKST / FUNNEL_S / TESTS / HI09.FW < prev    next >
Text File  |  1992-05-27  |  3KB  |  112 lines
  1. HI09: This example demonstrates how FunnelWeb can be used to create generics
  2.       in languages that do not already provide them.
  3.  
  4. @! We have to set the output line length limit up to cater for Barry Dwyer's
  5. @! rather horizontal coding style.
  6. @p maximum_output_line_length = 100
  7.  
  8. @O@<hi09.out@>==@{
  9. @<Generic Set Module@>@(NaryTree@,NaryTreeSet@)
  10. @}
  11.  
  12. @$@<Generic Set Module@>@(@2@)==@{@-
  13. @! @1 is the base type, @2 is the set type.
  14. [inherit ('@1'), environment ('@2')]
  15.  
  16. module @2;
  17.  
  18. type  @2 = ^@2Record;
  19.       @2Record = record
  20.          Member: @1;
  21.          Next: @2;
  22.          end;
  23.  
  24. procedure Null@2 (var Result: @2);
  25. begin new (Result);
  26. Result^.Member := (- MaxInt)::@1;
  27. Result^.Next := nil end;
  28.  
  29. function IsNull@2 (S: @2): boolean;
  30. begin IsNull@2 := S^.Member::integer = - MaxInt end;
  31.  
  32. procedure ForEach@1 (S: @2; procedure DoIt (i: @1));
  33. var   ThisS, NextS: @2;
  34. begin ThisS := S;
  35. while ThisS^.Member::integer <> - MaxInt do
  36.    begin NextS := ThisS^.Next;
  37.    DoIt (ThisS^.Member);
  38.    ThisS := NextS end;
  39. end;
  40.  
  41. function First@1 (S: @2): @1;
  42. begin First@1 := S^.Member end;
  43.  
  44. function Is@1InSet (i: @1; S: @2): boolean;
  45.    procedure TestEquals (j: @1);
  46.    begin if Equal@1 (i, j) then Is@1InSet := true; end;
  47. begin Is@1InSet := false; ForEach@1 (S, TestEquals); end;
  48.  
  49. function Includes@2 (S1, S2: @2): boolean;
  50. var Result: boolean;
  51.    procedure TestIfInS1 (i: @1);
  52.    begin if Result then if not Is@1InSet (i, S1) then Result := false; end;
  53. begin Result := true;
  54. ForEach@1 (S2, TestIfInS1);
  55. Includes@2 := Result end;
  56.  
  57. function Disjoint@2s (S1, S2: @2): boolean;
  58. var Result: boolean;
  59.    procedure TestIfInS1 (i: @1);
  60.    begin if Result then if Is@1InSet (i, S1) then Result := false; end;
  61. begin Result := true;
  62. ForEach@1 (S2, TestIfInS1);
  63. Disjoint@2s := Result end;
  64.  
  65. function Equal@2 (S1, S2: @2): boolean;
  66. begin
  67. Equal@2 := Includes@2 (S1, S2) and Includes@2 (S2, S1);
  68. end;
  69.  
  70. procedure Insert@1 (i: @1; var S: @2);
  71. var   This, Pred, Succ: @2;
  72. begin
  73. if not Is@1InSet (i, S) then
  74.    begin
  75.    Pred := nil; Succ := S;
  76.    while Succ^.Member::integer > i::integer do begin
  77.       Pred := Succ; Succ := Succ^.Next end;
  78.    if Succ^.Member::integer < i::integer then begin
  79.       new (This); This^.Next := Succ; This^.Member := i;
  80.       if Pred <> nil then Pred^.Next := This else S := This;
  81.       end;
  82.    end;
  83. end;
  84.  
  85. procedure Insert@1s (S1: @2; var S2: @2);
  86. var   This, Pred, Succ: @2;
  87.    procedure Add@1 (i: @1);
  88.    begin Insert@1 (i, S2) end;
  89. begin
  90. ForEach@1 (S1, Add@1);
  91. end;
  92.  
  93. procedure Remove@1 (i: @1; var S: @2);
  94. var   Pred, This: @2;
  95. begin
  96. Pred := nil; This := S;
  97. while not Equal@1 (This^.Member, i) do begin
  98.    Pred := This; This := This^.Next end;
  99. if Pred <> nil then Pred^.Next := This^.Next else S := This^.Next;
  100. Dispose (This);
  101. end;
  102.  
  103. procedure Dispose@2 (var S: @2);
  104. var   Old: @2;
  105. begin
  106. while S <> nil do begin Old := S; S := S^.Next; Dispose (Old) end;
  107. end;
  108.  
  109. end.
  110. @}
  111.  
  112.