home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / FMAP.SA < prev    next >
Text File  |  1995-02-05  |  10KB  |  261 lines
  1. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  2. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  3. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  4. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  5. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  6. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  7.  
  8. -- fmap.sa: Hash table based maps from objects to objects.
  9. -------------------------------------------------------------------
  10. class FMAP{K,T} is
  11.    -- Hash array based maps from key objects of type K to target 
  12.    -- objects of type T requiring writebacks. 
  13.    -- 
  14.    -- In this form void may not be a key, `key_nil' may be redefined.
  15.    -- 
  16.    -- If K is a subtype of $IS_EQ{K}, then `is_eq' will be used for
  17.    -- key equality test (eg. string equality for STR), otherwise 
  18.    -- object equality is used.  Notice that in an FMAP{$OB}, unless
  19.    -- $IS_EQ{$OB} has been defined (_not_ $IS_EQ{K}), the equality
  20.    -- routine will not be used.
  21.    -- 
  22.    -- If K is a subtype of $HASH, then `hash' will be used for the hash
  23.    -- value, otherwise the element `id' will be used.
  24.    -- 
  25.    -- May be inherited with `key_eq', `key_nil', and `key_hash' redefined
  26.    -- to get a different behavior.
  27.    -- 
  28.    -- The tables grow by amortized doubling and so require writeback
  29.    -- when inserting and deleting elements.  We
  30.    -- keep the load factor at .5 to cut down on collision snowballing.
  31.    -- The simple collision resolution allows us to support deletions,
  32.    -- but makes the behavior quadratic with poor hash functions.
  33.    -- Puts a sentinel at the end of the table to avoid one check while
  34.    -- searching.
  35.    
  36.    private include AREF{TUP{K,T}};
  37.    
  38.    private attr hsize:INT;    -- Number of stored entries.
  39.  
  40.    invariant:BOOL is        
  41.       -- Class invariant.
  42.       return void(self) or hsize.is_bet(0,asize) end;
  43.  
  44.    key_eq(k1,k2:K):BOOL is
  45.       -- True if `k1' is equal to `k2' for the semantics of this set.
  46.       -- If K is a subtype of $IS_EQ{K}, use K::is_eq (eg. string 
  47.       -- equality for STR), otherwise use object equality.
  48.       -- Often redefined in descendants.
  49.       typecase k1 
  50.       when $IS_EQ{K} then return k1.is_eq(k2) 
  51. --    else return SYS::ob_eq(k1,k2) end end;                                    -- NLP
  52.       else; end; return SYS::ob_eq(k1,k2); end;                                 -- NLP
  53.  
  54.    key_nil:K is
  55.       -- The key value used to represent an empty hash entry.
  56.       -- If T descends from $NIL{T}, use T::nil, otherwise use void. 
  57.       -- Often redefined in descendants.      
  58.       k:K; 
  59.       typecase k 
  60.       when $NIL{K} then return k.nil
  61. --    else return void end end;                                                 -- NLP
  62.       else; end; return void; end;                                              -- NLP
  63.    
  64.    key_hash(k:K):INT is
  65.       -- The hash index into self for `k'. Must have the property that
  66.       -- two elements which are `key_eq' have the same hash value. 
  67.       -- If K is a subtype of $HASH use K::hash, otherwise use `id'.
  68.       -- Often redefined in descendants. 
  69.       typecase k 
  70.       when $HASH then return k.hash 
  71. --    else return SYS::id(k) end end;                                           -- NLP
  72.       else; end; return SYS::id(k); end;                                        -- NLP
  73.  
  74.    size:INT is 
  75.       -- Number of entries in the table. Self may be void.
  76. --    if void(self) then return 0 else return hsize end end;                    -- NLP
  77.       if void(self) then return 0; end; return hsize; end;                      -- NLP
  78.    
  79.    create:SAME is return void end;
  80.  
  81.    create(n:INT):SAME 
  82.       -- Make a table capable of dealing with `n' elements without
  83.       -- expansion. You can simply insert into a void table to create 
  84.       -- one as well. Self may be void (and usually is).
  85.       pre n>=1 is 
  86.       return allocate(1.lshift((3*n/2).highest_bit+1)+1) end;
  87.  
  88.    private allocate(n:INT):SAME is
  89.       -- Allocate `n' locations (must be power of 2 plus 1) and
  90.       -- initialize to `(elt_nil,void)'.
  91.       r::=new(n); 
  92.       if ~void(key_nil) then loop r.aset!(#(key_nil,void)) end end;
  93.       return r end;
  94.    
  95.    pairs!:TUP{K,T} is
  96.       -- Yield the input/output pairs of self in an arbitrary order.
  97.       -- Do not insert or delete from self while calling this.
  98.       -- Self may be void.
  99.       if ~void(self) then
  100.      loop r::=aelt!; 
  101.         if ~key_eq(r.t1,key_nil) then yield r end end end end;  
  102.    
  103.    keys!:K is
  104.       -- Yield the keys in self in an arbitrary order. Do not insert
  105.       -- or delete from self while calling this.
  106.       -- Self may be void.
  107.       if ~void(self) then
  108.      loop r::=aelt!.t1; 
  109.         if ~key_eq(r,key_nil) then yield r end end end end;
  110.  
  111.    targets!:T is
  112.       -- Yield the target objects contained in self in an arbitrary
  113.       -- order. Do not insert or delete from self while calling this.
  114.       -- Self may be void.
  115.       if ~void(self) then
  116.      loop e::=aelt!; 
  117.         if ~key_eq(e.t1,key_nil) then yield e.t2 end end end end;
  118.    
  119.    test(k:K):BOOL is
  120.       -- True if the key `k' is mapped by self.
  121.       -- Self may be void.
  122.       if void(self) then return false end; 
  123.       h::=key_hash(k).band(asize-2);
  124.       loop tk::=[h].t1; 
  125.      if key_eq(tk,k) then return true
  126.      elsif key_eq(tk,key_nil) then break! end; 
  127.      h:=h+1 end;
  128.       if h=asize-1 then h:=0; -- hit sentinel
  129.      loop tk::=[h].t1; 
  130.         if key_eq(tk,k) then return true
  131.         elsif key_eq(tk,key_nil) then break! end; 
  132.         h:=h+1 end;
  133.      assert h/=asize-1 end;
  134.       return false end;
  135.  
  136.    get(k:K):T is
  137.       -- If `k' is a key, return the corresponding target, otherwise
  138.       -- return void. Self may be void.
  139.       if void(self) then return void end; 
  140.       h::=key_hash(k).band(asize-2);
  141.       loop tk::=[h].t1; 
  142.      if key_eq(tk,k) then return [h].t2
  143.      elsif key_eq(tk,key_nil) then break! end; 
  144.      h:=h+1 end;
  145.       if h=asize-1 then h:=0; -- hit sentinel
  146.      loop tk::=[h].t1; 
  147.         if key_eq(tk,k) then return [h].t2
  148.         elsif key_eq(tk,key_nil) then break! end; 
  149.         h:=h+1 end;
  150.      assert h/=asize-1 end; -- table mustn't be filled
  151.       return void end;
  152.    
  153.    get_pair(k:K):TUP{K,T} is
  154.       -- If `k' is a key, return the corresponding key/target pair.
  155.       -- Otherwise return #(key_nil,void). Useful when different
  156.       -- objects are treated as equal by `key_eq'. 
  157.       -- Self may be void.
  158.       if void(self) then return #(key_nil,void) end; 
  159.       h::=key_hash(k).band(asize-2);
  160.       loop tk::=[h].t1; 
  161.      if key_eq(tk,k) then return [h]
  162.      elsif key_eq(tk,key_nil) then break! end; 
  163.      h:=h+1 end;
  164.       if h=asize-1 then h:=0; -- hit sentinel
  165.      loop tk::=[h].t1; 
  166.         if key_eq(tk,k) then return [h]
  167.         elsif key_eq(tk,key_nil) then break! end; 
  168.         h:=h+1 end;
  169.      assert h/=asize-1 end; -- table mustn't be filled
  170.       return #(key_nil,void) end;
  171.    
  172.    private double_size:SAME 
  173.       -- A new table of twice the size of self with self's entries
  174.       -- copied over. 
  175.       pre ~void(self) is
  176.       ns::=(asize-1)*2+1; r::=allocate(ns); 
  177.       loop r:=r.insert_pair(pairs!) end; 
  178.       return r end;
  179.  
  180.    insert(k:K,t:T):SAME is
  181.       -- A possibly new table which includes the key/target pair `k',
  182.       -- `t'. If `k' is already present, replaces the current key and 
  183.       -- target with `k,t'. Usage: `tbl:=tbl.insert(k,t)'. Creates a 
  184.       -- new table if void(self).
  185.       r::=self;
  186.       if void(r) then r:=allocate(5)
  187.      elsif (hsize+1)*2>asize then r:=double_size end;
  188.       h::=r.key_hash(k).band(r.asize-2);
  189.       asm::=r.asize-1;
  190.       loop tk::=r[h].t1; 
  191.      if key_eq(tk,key_nil) then break! end;
  192.      if key_eq(tk,k) then r[h]:=#(k,t); return r end;
  193.      h:=h+1 end;
  194.       if h=asm then h:=0;    -- hit sentinel
  195.      loop tk::=r[h].t1; 
  196.         if key_eq(tk,key_nil) then break! end;
  197.         if key_eq(tk,k) then r[h]:=#(k,t); return r end;
  198.         h:=h+1 end;
  199.      assert h/=asm end; -- table mustn't be filled     
  200.       r[h]:=#(k,t); r.hsize:=r.hsize+1; return r end;
  201.  
  202.    insert_pair(p:TUP{K,T}):SAME is
  203.       -- Insert the key/target pair held by the tuple arg.
  204.       -- If the key is already present, replaces it with the new
  205.       -- key and target. `tbl:=tbl.insert(p)'. Creates a new table 
  206.       -- if void(self).
  207.       return insert(p.t1,p.t2) end;
  208.       
  209.    private halve_size:SAME 
  210.       -- A new table of half the size of self with self's entries
  211.       -- copied over. 
  212.       pre ~void(self) and hsize<(asize-1)/4 is
  213.       ns::=(asize-1)/2+1; r::=allocate(ns); 
  214.       loop r:=r.insert_pair(pairs!) end; 
  215.       return r end;
  216.    
  217.    delete(k:K):SAME is
  218.       -- A possibly new table which deletes the element with key 
  219.       -- `k' if it is contained in self. Usage: `tbl:=tbl.delete(k)'.
  220.       -- Self may be void.
  221.       if void(self) then return void end; 
  222.       h::=key_hash(k).band(asize-2);
  223.       loop tk::=[h].t1; 
  224.      if key_eq(tk,key_nil) then return self
  225.          elsif key_eq(tk,k) then break! end;
  226.      if h=asize-2 then h:=0 else h:=h+1 end end;
  227.       [h]:=#(key_nil,void); -- h is the index of arg
  228.       hsize:=hsize-1; i::=h; 
  229.      -- Now check the block after h for collisions.
  230.       loop 
  231.      if i=asize-2 then i:=0 else i:=i+1 end;
  232.      tk::=[i].t1; 
  233.      if key_eq(tk,key_nil) then break! end; 
  234.      hsh::=key_hash(tk).band(asize-2);
  235.      if hsh<=i then        -- block doesn't wrap around
  236.         if h<i and h>=hsh then -- hole in way
  237.            [h]:=[i]; h:=i; [i]:=#(key_nil,void) end;
  238.      else            -- block wraps
  239.         if h>=hsh or h<i then -- hole in way
  240.            [h]:=[i]; h:=i; [i]:=#(key_nil,void) end end end;
  241.       if asize>=33 and hsize<(asize-1)/4 then return halve_size
  242. --    else return self end end;                                                 -- NLP
  243.       end; return self; end;                                                    -- NLP
  244.  
  245.    clear:SAME is
  246.       -- Clear out self, return the space if it has 17 or less entries
  247.       -- otherwise return void. Self may be void.
  248.       if void(self) then return void end;
  249.       if asize<=17 then r::=self; r.hsize:=0; 
  250.      loop aset!(#(key_nil,void)) end; return self
  251. --    else return void end end;                                                 -- NLP
  252.       end; return void; end;                                                    -- NLP
  253.  
  254.    is_empty:BOOL is
  255.       -- True if the set is empty. Self may be void.
  256.       return void(self) or hsize=0 end;
  257.    
  258. end; -- class FMAP{K,T}
  259.  
  260. -------------------------------------------------------------------
  261.