home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / compcomp / tpyacc / yreftool.pas < prev    next >
Pascal/Delphi Source File  |  1991-03-05  |  5KB  |  174 lines

  1.  
  2. unit YRefTools;
  3.  
  4. (* This module supplies generic hash table and quicksort routines used
  5.    by the YREF program. *)
  6.  
  7. interface
  8.  
  9. (* Quicksort: *)
  10.  
  11. type
  12.  
  13. OrderPredicate = function (i, j : Integer) : Boolean;
  14. SwapProc = procedure (i, j : Integer);
  15.  
  16. procedure quicksort(lo, hi: Integer;
  17.                     less : OrderPredicate;
  18.                     swap : SwapProc);
  19.   (* General inplace sorting procedure based on the quicksort algorithm.
  20.      This procedure can be applied to any sequential data structure;
  21.      only the corresponding routines less which compares, and swap which
  22.      swaps two elements i,j of the target data structure, must be
  23.      supplied as appropriate for the target data structure.
  24.      - lo, hi: the lower and higher indices, indicating the elements to
  25.        be sorted
  26.      - less(i, j): should return true if element no. i `is less than'
  27.        element no. j, and false otherwise; any total quasi-ordering may
  28.        be supplied here (if neither less(i, j) nor less(j, i) then elements
  29.        i and j are assumed to be `equal').
  30.      - swap(i, j): should swap the elements with index i and j *)
  31.  
  32. (* Generic hash table routines (based on quadratic rehashing; hence the
  33.    table size must be a prime number): *)
  34.  
  35. type
  36.  
  37. TableLookupProc = function(k : Integer) : String;
  38. TableEntryProc  = procedure(k : Integer; symbol : String);
  39.  
  40. function key(symbol : String;
  41.              table_size : Integer;
  42.              lookup : TableLookupProc;
  43.              entry  : TableEntryProc) : Integer;
  44.   (* returns a hash table key for symbol; inserts the symbol into the
  45.      table if necessary
  46.      - table_size is the symbol table size and must be a fixed prime number
  47.      - lookup is the table lookup procedure which should return the string
  48.        at key k in the table ('' if entry is empty)
  49.      - entry is the table entry procedure which is assumed to store the
  50.        given symbol at the given location *)
  51.  
  52. function definedKey(symbol : String;
  53.                     table_size : Integer;
  54.                     lookup : TableLookupProc) : Boolean;
  55.   (* checks the table to see if symbol is in the table *)
  56.  
  57. implementation
  58.  
  59. procedure fatal(msg : String);
  60.   (* writes a fatal error message and exits *)
  61.   begin
  62.     writeln(msg);
  63.     halt(1);
  64.   end(*fatal*);
  65.  
  66. (* Quicksort: *)
  67.  
  68. procedure quicksort(lo, hi: Integer;
  69.                     less : OrderPredicate;
  70.                     swap : SwapProc);
  71.   (* derived from the quicksort routine in QSORT.PAS in the Turbo Pascal
  72.      distribution *)
  73.   procedure sort(l, r: Integer);
  74.     var i, j, k : Integer;
  75.     begin
  76.       i := l; j := r; k := (l+r) DIV 2;
  77.       repeat
  78.         while less(i, k) do inc(i);
  79.         while less(k, j) do dec(j);
  80.         if i<=j then
  81.           begin
  82.             swap(i, j);
  83.             if k=i then k := j (* pivot element swapped! *)
  84.             else if k=j then k := i;
  85.             inc(i); dec(j);
  86.           end;
  87.       until i>j;
  88.       if l<j then sort(l,j);
  89.       if i<r then sort(i,r);
  90.     end(*sort*);
  91.   begin
  92.     if lo<hi then sort(lo,hi);
  93.   end(*quicksort*);
  94.  
  95. (* Generic hash table routines: *)
  96.  
  97. function hash(str : String; table_size : Integer) : Integer;
  98.   (* computes a hash key for str *)
  99.   var i, key : Integer;
  100.   begin
  101.     key := 0;
  102.     for i := 1 to length(str) do
  103.       inc(key, ord(str[i]));
  104.     hash := key mod table_size + 1;
  105.   end(*hash*);
  106.  
  107. procedure newPos(var pos, incr, count : Integer; table_size : Integer);
  108.   (* computes a new position in the table (quadratic rehashing)
  109.      - pos: current position (+inc)
  110.      - incr: current increment (+2)
  111.      - count: current number of collisions (+1)
  112.      quadratic rehashing formula for position of str after n collisions:
  113.        pos(str, n) = (hash(str)+n^2) mod table_size +1
  114.      note that n^2-(n-1)^2 = 2n-1 <=> n^2 = (n-1)^2 + (2n-1) for n>0,
  115.      i.e. the increment inc=2n-1 increments by two in each collision *)
  116.   begin
  117.     inc(count);
  118.     inc(pos, incr);
  119.     if pos>table_size then pos := pos mod table_size + 1;
  120.     inc(incr, 2)
  121.   end(*newPos*);
  122.  
  123. function key(symbol : String;
  124.              table_size : Integer;
  125.              lookup : TableLookupProc;
  126.              entry  : TableEntryProc) : Integer;
  127.   var pos, incr, count : Integer;
  128.   begin
  129.     pos := hash(symbol, table_size);
  130.     incr := 1;
  131.     count := 0;
  132.     while count<=table_size do
  133.       if lookup(pos)='' then
  134.         begin
  135.           entry(pos, symbol);
  136.           key := pos;
  137.           exit
  138.         end
  139.       else if lookup(pos)=symbol then
  140.         begin
  141.           key := pos;
  142.           exit
  143.         end
  144.       else
  145.         newPos(pos, incr, count, table_size);
  146.     fatal('symbol table overflow')
  147.   end(*key*);
  148.  
  149. function definedKey(symbol : String;
  150.                     table_size : Integer;
  151.                     lookup : TableLookupProc) : Boolean;
  152.   var pos, incr, count : Integer;
  153.   begin
  154.     pos := hash(symbol, table_size);
  155.     incr := 1;
  156.     count := 0;
  157.     while count<=table_size do
  158.       if lookup(pos)='' then
  159.         begin
  160.           definedKey := false;
  161.           exit
  162.         end
  163.       else if lookup(pos)=symbol then
  164.         begin
  165.           definedKey := true;
  166.           exit
  167.         end
  168.       else
  169.         newPos(pos, incr, count, table_size);
  170.     definedKey := false
  171.   end(*definedKey*);
  172.  
  173. end(*YRefTools*).
  174.