home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / TUP.SA < prev    next >
Text File  |  1995-02-05  |  6KB  |  184 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. -- tup.sa: Tuples
  9. -------------------------------------------------------------------
  10. value class TUP{T1} < $HASH, $IS_EQ{SAME} is
  11.    attr t1:T1;
  12.    
  13.    create(at1:T1):SAME is
  14.       return t1(at1) end;
  15.    
  16.    is_eq(e:SAME):BOOL is
  17.       -- True if the component of self and `e' are equal.
  18.       lt1::=t1;
  19.       typecase lt1
  20.       when $IS_EQ{T1} then return lt1.is_eq(e.t1) 
  21. --    else return SYS::ob_eq(lt1,e.t1) end end;                                 -- NLP
  22.       else; end; return SYS::ob_eq(lt1,e.t1); end;                              -- NLP
  23.    
  24.    hash:INT is
  25.       -- A simple hash value computed from the hash values of the 
  26.       -- component. For this to work, this must either be a value
  27.       -- type which defines a hash value or a reference type.
  28.       lt1::=t1; 
  29.       typecase lt1
  30.       when $HASH then return lt1.hash
  31. --    else return SYS::id(lt1) end end;                                         -- NLP
  32.       else; end; return SYS::id(lt1); end;                                      -- NLP
  33.    
  34. end; -- class TUP{T1}
  35.  
  36. -------------------------------------------------------------------
  37. value class TUP{T1,T2} < $HASH, $IS_EQ{SAME} is
  38.    attr t1:T1;
  39.    attr t2:T2;
  40.    
  41.    create(at1:T1, at2:T2):SAME is
  42.       return t1(at1).t2(at2) end;      
  43.  
  44.    is_eq(e:SAME):BOOL is
  45.       -- True if the components of self and `e' are equal.
  46.       lt1::=t1; 
  47.       typecase lt1
  48.       when $IS_EQ{T1} then 
  49.      if ~lt1.is_eq(e.t1) then return false end;
  50.       else
  51.      if ~SYS::ob_eq(lt1,e.t1) then return false end end;
  52.       lt2::=t2; 
  53.       typecase lt2
  54.       when $IS_EQ{T2} then 
  55.      if ~lt2.is_eq(e.t2) then return false end;
  56.       else
  57.      if ~SYS::ob_eq(lt2,e.t2) then return false end end;
  58.       return true end;     
  59.    
  60.    hash:INT is
  61.       -- A simple hash value computed from the hash values of the 
  62.       -- components. For this to work, these must either be value
  63.       -- types which define hash values or reference types.
  64.       h1,h2:INT; lt1::=t1; lt2::=t2;
  65.       typecase lt1
  66.       when $HASH then h1:=lt1.hash
  67.       else h1:=SYS::id(lt1) end;
  68.       typecase lt2
  69.       when $HASH then h2:=lt2.hash
  70.       else h2:=SYS::id(lt2) end;
  71.       return h1.bxor(h2.lshift(2)) end;
  72.    
  73. end; -- class TUP{T1,T2}
  74.  
  75. -------------------------------------------------------------------
  76. value class TUP{T1,T2,T3} < $HASH, $IS_EQ{SAME} is
  77.    attr t1:T1;
  78.    attr t2:T2;
  79.    attr t3:T3;
  80.  
  81.    create(at1:T1, at2:T2, at3:T3):SAME is
  82.       return t1(at1).t2(at2).t3(at3) end;
  83.  
  84.    is_eq(e:SAME):BOOL is
  85.       -- True if the components of self and `e' are equal.
  86.       lt1::=t1; 
  87.       typecase lt1
  88.       when $IS_EQ{T1} then 
  89.      if ~lt1.is_eq(e.t1) then return false end;
  90.       else
  91.      if ~SYS::ob_eq(lt1,e.t1) then return false end end;
  92.       lt2::=t2; 
  93.       typecase lt2
  94.       when $IS_EQ{T2} then 
  95.      if ~lt2.is_eq(e.t2) then return false end;
  96.       else
  97.      if ~SYS::ob_eq(lt2,e.t2) then return false end end;
  98.       lt3::=t3; 
  99.       typecase lt3
  100.       when $IS_EQ{T3} then 
  101.      if ~lt3.is_eq(e.t3) then return false end;
  102.       else
  103.      if ~SYS::ob_eq(lt3,e.t3) then return false end end;
  104.       return true end;     
  105.    
  106.    hash:INT is
  107.       -- A simple hash value computed from the hash values of the 
  108.       -- components. For this to work, these must either be value
  109.       -- types which define hash values or reference types.
  110.       h1,h2,h3:INT; lt1::=t1; lt2::=t2; lt3::=t3;
  111.       typecase lt1
  112.       when $HASH then h1:=lt1.hash
  113.       else h1:=SYS::id(lt1) end;
  114.       typecase lt2
  115.       when $HASH then h2:=lt2.hash
  116.       else h2:=SYS::id(lt2) end;
  117.       typecase lt3
  118.       when $HASH then h3:=lt3.hash
  119.       else h3:=SYS::id(lt3) end;
  120.       return h1.bxor(h2.lshift(2)).bxor(h3.lshift(4)) end;
  121.    
  122. end; -- class TUP{T1,T2,T3}
  123.  
  124. -------------------------------------------------------------------
  125. value class TUP{T1,T2,T3,T4} < $HASH, $IS_EQ{SAME} is
  126.    attr t1:T1;
  127.    attr t2:T2;
  128.    attr t3:T3;
  129.    attr t4:T4;
  130.  
  131.    create(at1:T1, at2:T2, at3:T3, at4:T4):SAME is
  132.       return t1(at1).t2(at2).t3(at3).t4(at4) end;
  133.  
  134.    is_eq(e:SAME):BOOL is
  135.       -- True if the components of self and `e' are equal.
  136.       lt1::=t1; 
  137.       typecase lt1
  138.       when $IS_EQ{T1} then 
  139.      if ~lt1.is_eq(e.t1) then return false end;
  140.       else
  141.      if ~SYS::ob_eq(lt1,e.t1) then return false end end;
  142.       lt2::=t2; 
  143.       typecase lt2
  144.       when $IS_EQ{T2} then 
  145.      if ~lt2.is_eq(e.t2) then return false end;
  146.       else
  147.      if ~SYS::ob_eq(lt2,e.t2) then return false end end;
  148.       lt3::=t3; 
  149.       typecase lt3
  150.       when $IS_EQ{T3} then 
  151.      if ~lt3.is_eq(e.t3) then return false end;
  152.       else
  153.      if ~SYS::ob_eq(lt3,e.t3) then return false end end;
  154.       lt4::=t4; 
  155.       typecase lt4
  156.       when $IS_EQ{T4} then 
  157.      if ~lt4.is_eq(e.t4) then return false end;
  158.       else
  159.      if ~SYS::ob_eq(lt4,e.t4) then return false end end;
  160.       return true end;     
  161.    
  162.    hash:INT is
  163.       -- A simple hash value computed from the hash values of the 
  164.       -- components. For this to work, these must either be value
  165.       -- types which define hash values or reference types.
  166.       h1,h2,h3,h4:INT; lt1::=t1; lt2::=t2; lt3::=t3; lt4::=t4;
  167.       typecase lt1
  168.       when $HASH then h1:=lt1.hash
  169.       else h1:=SYS::id(lt1) end;
  170.       typecase lt2
  171.       when $HASH then h2:=lt2.hash
  172.       else h2:=SYS::id(lt2) end;
  173.       typecase lt3
  174.       when $HASH then h3:=lt3.hash
  175.       else h3:=SYS::id(lt3) end;
  176.       typecase lt4
  177.       when $HASH then h4:=lt4.hash
  178.       else h4:=SYS::id(lt4) end;
  179.       return h1.bxor(h2.lshift(2)).bxor(h3.lshift(4)).bxor(h4.lshift(6)) end;
  180.    
  181. end; -- class TUP{T1,T2,T3,T4}
  182.  
  183. -------------------------------------------------------------------
  184.