home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / FQSET.SA < prev    next >
Text File  |  1995-02-05  |  15KB  |  382 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. -- fqset.sa: Sets which support partial element state queries.
  9. -------------------------------------------------------------------
  10. class FQSET{Q,T} is
  11.    -- Class to be inherited by hash array based sets of elements of
  12.    -- type T, which support queries of type Q that depend only on part
  13.    -- of the state of an element. Uses writebacks. 
  14.    -- 
  15.    -- Descendant will usually redefine: `query_test', `query_hash', and
  16.    -- `elt_hash'. More rarely, it may also redefine: `elt_eq' and  
  17.    -- `elt_nil'.
  18.    -- 
  19.    -- A table will never have two elements that are `elt_eq' to 
  20.    -- each other, though there may be many elements responding to
  21.    -- a particular query.
  22.    --
  23.    -- The tables grow by amortized doubling and so require writeback
  24.    -- when inserting and deleting elements. The hash function is trivial
  25.    -- as is the collision resolution since searching through successive
  26.    -- entries is cheaper than computing fancy hash functions.
  27.    -- The simple collision resolution allows us to support deletions,
  28.    -- but makes the behavior quadratic with poor hash functions.
  29.    -- Puts a sentinel at the end of the table to avoid one check while
  30.    -- searching.
  31.  
  32.    private include AREF{T};
  33.    
  34.    private attr hsize:INT;    -- Number of stored entries.
  35.    
  36.    invariant:BOOL is        
  37.       -- Class invariant.
  38.       return void(self) or hsize.is_bet(0,asize) end;
  39.    
  40.    query_test(q:Q,t:T):BOOL is
  41.       -- True if `t' satisfies the query posed by `q'.
  42.       -- Usually redefined in descendants.
  43.       return SYS::ob_eq(q,t) end;
  44.    
  45.    query_hash(q:Q):INT is
  46.       -- The hash value associated with the query `q'.
  47.       -- If an element satisfies `query_test(q,t)', then `query_hash(q)' 
  48.       -- must equal `elt_hash(t)'. Should produce full range of integers.
  49.       -- Usually redefined in descendants.      
  50.       typecase q when $HASH then return q.hash
  51. --    else return SYS::id(q) end end;                                           -- NLP
  52.       else; end; return SYS::id(q); end;                                        -- NLP
  53.    
  54.    elt_hash(e:T):INT is
  55.       -- The hash value associated with the element `e'.
  56.       -- Should produce full range of integers.
  57.       -- Usually redefined in descendants.            
  58.       typecase e when $HASH then return e.hash
  59. --    else return SYS::id(e) end end;                                           -- NLP
  60.       else; end; return SYS::id(e); end;                                        -- NLP
  61.  
  62.    elt_eq(e1,e2:T):BOOL is
  63.       -- True if `e1' is equal to `e2' for the semantics of this set.
  64.       -- May be redefined in descendants.
  65.       typecase e1 when $IS_EQ{T} then return e1.is_eq(e2)
  66. --    else return SYS::ob_eq(e1,e2) end end;                                    -- NLP
  67.       else; end; return SYS::ob_eq(e1,e2); end;                                 -- NLP
  68.    
  69.    elt_nil:T is
  70.       -- The element used to represent an empty hash entry.
  71.       -- If T descends from $NIL{T}, use T::nil, otherwise use void. 
  72.       -- Often redefined in descendants.      
  73.       t:T; 
  74.       typecase t 
  75.       when $NIL{T} then return t.nil
  76. --    else return void end end;                                                 -- NLP
  77.       else; end; return void; 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. You can
  83.       -- simply insert into a void table to create one as well.
  84.       -- Self may be void.
  85.       pre n>=1 is 
  86.       r::=allocate(1.lshift((3*n/2).highest_bit+1)+1);
  87.       return r end;
  88.    
  89.    private allocate(n:INT):SAME is
  90.       -- Allocate `n' locations (must be power of 2 plus 1) and
  91.       -- initialize to `elt_nil'.
  92.       r::=new(n); 
  93.       if ~void(elt_nil) then loop r.aset!(elt_nil) end end;
  94.       return r end;
  95.    
  96.    size:INT is
  97.       -- Number of entries in the table. Self may be void.
  98. --    if void(self) then return 0 else return hsize end end;                    -- NLP
  99.       if void(self) then return 0; end; return hsize; end;                      -- NLP
  100.    
  101.    copy:SAME is
  102.       -- A copy of self.
  103.       r:SAME; loop r:=r.insert(elt!) end; return r end;
  104.    
  105.    elt!:T is
  106.       -- Yield the elements in self in an arbitrary order. Do not insert
  107.       -- or delete from self while calling this. Self may be void.
  108.       if ~void(self) then 
  109.      loop r::=aelt!; 
  110.         if ~elt_eq(r,elt_nil) then yield r end end end end;
  111.  
  112.    get_query!(q:Q):T is
  113.       -- Retrieve all elements associated with the query `q'.
  114.       -- Self may be void.
  115.       if void(self) then quit end;
  116.       h::=query_hash(q).band(asize-2);    
  117.       loop e::=[h];
  118.      if query_test(q,e) then yield e
  119.      elsif elt_eq(e,elt_nil) then break! end;
  120.      h:=h+1 end;
  121.       if h=asize-1 then h:=0;    -- hit sentinel
  122.      loop e::=[h];
  123.         if query_test(q,e) then yield e
  124.         elsif elt_eq(e,elt_nil) then break! end;
  125.         h:=h+1 end;
  126.      assert h/=asize-1 end end; -- table mustn't be filled
  127.  
  128.    get_query(q:Q):T is
  129.       -- Retrieve the first element associated with the query arg.
  130.       -- Returns `elt_nil' if not present. Self may be void.
  131.       if void(self) then return void end;
  132.       h::=query_hash(q).band(asize-2);    
  133.       loop e::=[h];
  134.      if query_test(q,e) then return e
  135.      elsif elt_eq(e,elt_nil) then break! end;
  136.      h:=h+1 end;
  137.       if h=asize-1 then h:=0;    -- hit sentinel
  138.      loop e::=[h];
  139.         if query_test(q,e) then return e
  140.         elsif elt_eq(e,elt_nil) then break! end;
  141.         h:=h+1 end;
  142.      assert h/=asize-1 end;
  143.       return elt_nil end; -- table mustn't be filled
  144.    
  145.    test_query(q:Q):BOOL is
  146.       -- Test whether any elements are associated with the query `q'.
  147.       -- Self may be void.
  148.       if elt_eq(get_query(q),elt_nil) then return false
  149. --    else return true end end;                                                 -- NLP
  150.       end; return true; end;                                                    -- NLP
  151.    
  152.    test(e:T):BOOL is
  153.       -- True if `e' is `elt_eq' to an element contained in self. 
  154.       -- Self may be void.
  155.       if void(self) then return false end;  
  156.       h::=elt_hash(e).band(asize-2);
  157.       loop te::=[h];  
  158.      if elt_eq(te,e) then return true
  159.      elsif elt_eq(te,elt_nil) then break! end;  
  160.      h:=h+1 end;
  161.       if h=asize-1 then        -- hit sentinel
  162.      h:=0;
  163.      loop te::=[h];
  164.         if elt_eq(te,e) then return true
  165.         elsif elt_eq(te,elt_nil) then break! end;  
  166.         h:=h+1 end;
  167.      assert h/=asize-1 end; -- table mustn't be filled
  168.       return false end;
  169.    
  170.    get(e:T):T is
  171.       -- If `e' is `elt_eq' to a table entry, return that entry, 
  172.       -- otherwise return `elt_nil'. Useful when different objects 
  173.       -- are treated as equal (eg. a table of strings used to get a 
  174.       -- unique representative for each class of equal strings).
  175.       -- Self may be void.
  176.       if void(self) then return elt_nil end;
  177.       h::=elt_hash(e).band(asize-2);    
  178.       loop te::=[h];
  179.      if elt_eq(te,e) then return te
  180.      elsif elt_eq(te,elt_nil) then break! end;
  181.      h:=h+1 end;
  182.       if h=asize-1 then h:=0;    -- hit sentinel
  183.      loop te::=[h];
  184.         if elt_eq(te,e) then return te
  185.         elsif elt_eq(te,elt_nil) then break! end;
  186.         h:=h+1 end;
  187.      assert h/=asize-1 end; -- table mustn't be filled
  188.       return elt_nil end; 
  189.    
  190.    private double_size:SAME 
  191.       -- A new table of twice the size of self with self's entries
  192.       -- copied over. 
  193.       pre ~void(self) is
  194.       r::=allocate((asize-1)*2+1); 
  195.       loop r:=r.insert(elt!) end;
  196.       return r end;
  197.    
  198.    insert(e:T):SAME is
  199.       -- A possibly new table which includes `e'. If an entry 
  200.       -- is `elt_eq' to `e' then overwrite it with `e'.
  201.       -- Usage: `tbl:=tbl.insert(e)'. 
  202.       -- Creates a new table if void(self).
  203.       r::=self;
  204.       if elt_eq(e,elt_nil) then return r end;
  205.       if void(r) then r:=allocate(5)
  206.       elsif (hsize+1)*2>asize then r:=r.double_size end;
  207.       asz::=r.asize;
  208.       h::=r.elt_hash(e).band(asz-2);
  209.       loop te::=r[h];
  210.      if elt_eq(te,elt_nil) then break!
  211.      elsif elt_eq(te,e) then r[h]:=e; return r end;
  212.      h:=h+1 end;
  213.       if h=asz-1 then h:=0;    -- hit sentinel
  214.      loop te::=r[h];
  215.         if elt_eq(te,elt_nil) then break!
  216.         elsif elt_eq(te,e) then r[h]:=e; return r end;
  217.         h:=h+1 end;
  218.      assert h/=asz-1 end; -- table mustn't be filled     
  219.       r[h]:=e; r.hsize:=r.hsize+1; return r end;
  220.    
  221.    private halve_size:SAME 
  222.       -- A new table of half the size of self with self's entries
  223.       -- copied over. 
  224.       pre ~void(self) and hsize<(asize-1)/4 is
  225.       r::=allocate((asize-1)/2+1); 
  226.       loop r:=r.insert(elt!) end;
  227.       return r end;
  228.    
  229.    delete(e:T):SAME is
  230.       -- A possibly new table which deletes the element which an 
  231.       -- element of self that is `elt_eq' to `e' if it exists.
  232.       -- Doesn't modify the table if there is no such element.
  233.       -- Usage: `tbl:=tbl.delete(e)'. Self may be void.
  234.       if void(self) then return void end;
  235.       h::=elt_hash(e).band(asize-2);
  236.       loop te::=[h];
  237.      if elt_eq(te,elt_nil) then return self
  238.      elsif elt_eq(te,e) then break! end;
  239.      if h=asize-2 then h:=0 else h:=h+1 end end;
  240.       [h]:=elt_nil; hsize:=hsize-1; i::=h; -- h is the index of arg
  241.      -- Now check the block after h for collisions.
  242.       loop 
  243.      if i=asize-2 then i:=0 else i:=i+1 end;
  244.      te::=[i];
  245.      if elt_eq(te,elt_nil) then break! end;
  246.      hsh::=elt_hash(te).band(asize-2);
  247.      if hsh<=i then        -- block doesn't wrap around
  248.         if h<i and h>=hsh then -- hole in way
  249.            [h]:=[i]; h:=i; [i]:=elt_nil end
  250.      else            -- block wraps
  251.         if h>=hsh or h<i then -- hole in way
  252.            [h]:=[i]; h:=i; [i]:=elt_nil end end end;
  253.       if asize>=33 and hsize<(asize-1)/4 then return halve_size
  254. --    else return self end end;                                                 -- NLP
  255.       end; return self; end;                                                    -- NLP
  256.  
  257.    clear:SAME is
  258.       -- Clear out self, return the space if it has 17 or less entries
  259.       -- otherwise return void. Self may be void.
  260.       if void(self) then return void end;
  261.       if asize<=17 then 
  262.      hsize:=0; loop aset!(elt_nil) end; return self
  263. --    else return void end end;                                                 -- NLP
  264.       end; return void; end;                                                    -- NLP
  265.  
  266.    is_empty:BOOL is        
  267.       -- True if the set is empty. Self may be void.
  268.       return void(self) or hsize=0 end;
  269.    
  270.    is_eq(s:SAME):BOOL is    
  271.       -- True if `s' has the same elements as self. Self may be void.
  272.       loop if ~s.test(elt!) then return false end end;
  273.       loop if ~test(s.elt!) then return false end end;
  274.       return true end;
  275.    
  276.    is_disjoint_from(s:SAME):BOOL is
  277.       -- True if self and `s' have no elements in common.
  278.       -- Self may be void.
  279.       loop if s.test(elt!) then return false end end;
  280.       return true end;
  281.    
  282.    intersects(s:SAME):BOOL is
  283.       -- True if self and `s' have elements in common.
  284.       -- Self may be void.
  285.       return ~is_disjoint_from(s) end;
  286.    
  287.    is_subset(s:SAME):BOOL is
  288.       -- True if all elements of self are contained in `s'.
  289.       -- Self may be void.
  290.       loop if ~s.test(elt!) then return false end end;
  291.       return true end;
  292.    
  293.    to_union(s:SAME):SAME is
  294.       -- The union of self and `s', modifies self.
  295.       -- Self may be void.
  296.       r::=self; loop r:=r.insert(s.elt!) end; return r end;
  297.    
  298.    union(s:SAME):SAME is
  299.       -- A new set which is the union of self and `s'.
  300.       -- Self may be void.
  301.       return copy.to_union(s) end;
  302.    
  303.    to_intersect(s:SAME):SAME is
  304.       -- The intersection of self and `s', modifies self.
  305.       -- Self may be void.
  306.       r::=self; loop r:=r.delete(s.elt!) end; return r end;
  307.    
  308.    intersect(s:SAME):SAME is
  309.       -- A new set which is the intersection of self and `s'.
  310.       -- Self may be void.
  311.       r:SAME;
  312.       loop e::=elt!; if s.test(e) then r:=r.insert(e) end end;
  313.       return r end;
  314.    
  315.    to_difference(s:SAME):SAME is
  316.       -- The difference of self and `s', modifies self.
  317.       -- Self may be void.
  318.       r::=self; loop r:=r.delete(s.elt!) end; return r end;
  319.       
  320.    difference(s:SAME):SAME is
  321.       -- A new set which is the difference between self and arg.
  322.       -- Self may be void.
  323.       r:SAME;
  324.       loop e::=elt!; if ~s.test(e) then r:=r.insert(e) end end; 
  325.       return r end;
  326.    
  327.    to_sym_difference(s:SAME):SAME is
  328.       -- The symmetric difference of self and `s', modifies self.
  329.       -- Self may be void.
  330.       r::=self;
  331.       loop e::=s.elt!;
  332.      if r.test(e) then r:=r.delete(e) else r:=r.insert(e) end end;
  333.       return r end;
  334.    
  335.    sym_difference(s:SAME):SAME is
  336.       -- A new set which is the symmetric difference between self 
  337.       -- and `s'. Self may be void.
  338.       r:SAME;
  339.       loop e::=elt!; if ~s.test(e) then r:=r.insert(e) end end;
  340.       loop e::=s.elt!; if ~test(e) then r:=r.insert(e) end end;
  341.       return r end;
  342.    
  343.    map(m:ROUT{T}:T):SAME is
  344.       -- A new set whose elements are `m' applied to those of self.
  345.       -- Self may be void.
  346.       r:SAME; loop r:=r.insert(m.call(elt!)) end; return r end;
  347.       
  348.    filter(t:ROUT{T}:BOOL):SAME is
  349.       -- A new set whose elements are those of self which satisfy `t'.
  350.       -- Self may be void.
  351.       r:SAME;
  352.       loop e::=elt!; if t.call(e) then r:=r.insert(e) end end;
  353.       return r end;
  354.  
  355.    some(t:ROUT{T}:BOOL):BOOL is
  356.       -- True if some element of self satisfies `t'.
  357.       -- Self may be void.
  358. --    loop if t.call(elt!) then return true end end end;                        -- NLP !
  359.       loop if t.call(elt!) then return true; end; end; return false; end;       -- NLP !
  360.  
  361.    every(t:ROUT{T}:BOOL):BOOL is
  362.       -- True if every element of self satisfies `t'.
  363.       -- Self may be void.
  364.       loop if ~t.call(elt!) then return false end end;
  365.       return true end;
  366.  
  367.    notany(t:ROUT{T}:BOOL):BOOL is
  368.       -- True if none of the elements of self satisfies `t'.
  369.       -- Self may be void.
  370.       loop if t.call(elt!) then return false end end;
  371.       return true end;
  372.    
  373.    notevery(t:ROUT{T}:BOOL):BOOL is
  374.       -- True if not every element of self satisfies `t'.
  375.       -- Self may be void.
  376.       loop if ~t.call(elt!) then return true end end;
  377.       return false end;
  378.    
  379. end; -- class FQSET{Q,T}
  380.  
  381. -------------------------------------------------------------------
  382.