home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / FSTR.SA < prev    next >
Text File  |  1995-02-05  |  13KB  |  387 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. -- fstr.sa: Buffers for efficiently constructing strings.
  9. -------------------------------------------------------------------
  10. class FSTR < $IS_EQ{FSTR}, $IS_LT{FSTR}, $HASH is
  11.    -- Buffers for efficiently constructing strings by repeated
  12.    -- concatenation using amortized doubling.
  13.    
  14.    include FLIST{CHAR} 
  15.       asize->asize,loc->loc; -- Needs to be public for some uses.
  16.       -- Some useful features are:
  17.       -- size:INT  The current string size.
  18.       -- create(n:INT):SAME  A buffer of initial size `n'.
  19.       -- copy:SAME  A copy of self.
  20.       -- aget(ind:INT):CHAR  The character `ind'.
  21.       -- aset(ind:INT, c:CHAR)  Set character `ind' to `c'.
  22.       -- is_eq(l:SAME):BOOL  True if self equals l as strings.
  23.       -- is_empty:BOOL  True if self is the empty string.
  24.       -- clear  Make self represent the empty string.
  25.       -- elt!:CHAR  The characters in self.
  26.       -- elt!(beg:INT):CHAR  Characters starting at `beg'.
  27.       -- elt!(beg,num:INT):CHAR  `num' chars beginning at `beg'.
  28.       -- elt!(beg,num,step:INT):CHAR  `num' chars beginning at `beg',
  29.       --    stepping by `step'.
  30.       -- ind!:INT  The indices of the buffer.
  31.       -- contains(c:CHAR):BOOL  True if self contains `c'.
  32.       -- to_reverse  Reverse the order of the characters.
  33.     
  34.    create:SAME is
  35.       -- A new buffer.
  36.       return new(16) end;
  37.  
  38.    create(sz:INT):SAME 
  39.       -- A new buffer of size `sz'.
  40.       pre sz>=0 is
  41.       return new(sz) end;
  42.    
  43.    acopy(s:STR) is
  44.       -- overridden by a MACRO. Added by MBK.
  45.       loop aset![s.aelt!]; end;
  46.    end;
  47.  
  48.    acopyn(s:STR,n:INT) pre n <= s.length is
  49.       -- overridden by a MACRO. Added by MBK.
  50.       loop aset!(s[n.times!]) end;
  51.    end;
  52.  
  53.    acopyn(s:FSTR,n:INT) pre n <= s.length is
  54.       -- overridden by a MACRO. Added by MBK.
  55.       loop aset!(s[n.times!]) end;
  56.    end;
  57.  
  58.    
  59.    create(s:STR):SAME is
  60.       -- added by MBK to make STR::fstr:FSTR faster
  61.       if void(s) then
  62.      return create;
  63. --    else                                                                      -- NLP
  64.       end;                                                                      -- NLP
  65.      l ::= s.length;
  66.      r::=new(l); -- why 16?  Why not?
  67.      r.acopyn(s,l); -- this puppy is macroized into memcpy
  68.      r.loc := l;
  69.      return r;
  70. --    end;                                                                      -- NLP
  71.    end;
  72.      
  73.    length:INT is
  74.       -- The number of characters in self. Another name for `size'.
  75.       return size end;
  76.       
  77.    push(c:CHAR):SAME is
  78.       -- Add a new character to the end of self and return it.
  79.       -- If self is void, create a new list. Usage: `l:=l.push(e)'.
  80.       -- This routine needs to go fast too, which is the reason behind
  81.       -- the "l" temporary. Modified by MBK.
  82.       r:SAME;
  83.       l:INT;
  84.       if void(self) then r:=create; l := 0;
  85.       elsif loc<asize then r:=self; l := r.loc; -- normal path
  86.       else r:=new(2*asize); l := loc; r.acopyn(self,l) end;
  87.       r.loc:=l+1;
  88.       r[l]:=c;
  89.       return r;
  90.       end;
  91.    
  92.    str:STR is
  93.       -- A string version of self.
  94.       return STR::from_fstr(self) end;
  95.  
  96.    clear is
  97.       -- Set self to the empty string. Retain the array.
  98.       -- Self may be void.
  99.       if ~void(self) then loc:=0 end end;
  100.  
  101.    acopy(beg:INT,src:STR) is
  102.       -- overwridden by MACROS
  103.       loop aset!(beg,src.aelt!) end end;
  104.  
  105.    plus(s:STR):SAME 
  106.       -- Append the string `s' to self and return it.
  107.       -- modified by MBK to make it go fast.  Called by compiler frequently.
  108.       post result.str = initial(self).str + s is
  109.       r:SAME;
  110.       l ::= s.length;
  111.       if void(self) then
  112.      r:=create(2*l);
  113.       elsif (loc + l < asize) then
  114.      r:=self;
  115.       else
  116.      r :=new(2*(asize+l)); r.loc := loc; r.acopy(self);
  117.  
  118.       end;
  119.       if (l = 0) then return r; end;
  120.       r.acopy(r.loc,s);        -- This one is MACROIZED to a memcpy.
  121.       r.loc := r.loc + l;
  122. --      r::=self; loop r:=r.push(s.elt!) end; return r end;
  123.       return r; end;
  124.    
  125.    plus(s:SAME):SAME 
  126.       -- Append `s' to self and return it.
  127.       post result.str = initial(self).str + s.str is 
  128.       r::=self; loop r:=r.push(s.elt!) end; return r end;      
  129.  
  130.    plus(b:BOOL):SAME is 
  131.       -- Append `b' to self and return it.  
  132.       if b then return self + "true"
  133. --    else return self + "false" end end;                                       -- NLP
  134.       end; return self + "false"; end;                                          -- NLP
  135.    
  136.    plus(c:CHAR):SAME is 
  137.       -- Append `c' to self and return it. 
  138.       return push(c) end;
  139.    
  140.    plus(i:INT):SAME is 
  141.       -- Append `i' to self and return it.
  142.       return i.str_in(self) end;
  143.    
  144.    plus(f:FLT):SAME is 
  145.       -- Append `f' to self and return it.
  146.       return (self + (f.str)) end;
  147. --  OLD, better version, does not work as yet    return f.str_in(self) end;   
  148.  
  149.    private is_eq_helper(s:SAME,i:INT):BOOL is
  150.       -- Matt Kennel, INLS.  The reason for this
  151.       -- function's existence is that it will be overridden
  152.       -- by "memcmp" in MACROS.
  153.       loop if elt!/=s.elt! then return false end; end;
  154.       return true;
  155.    end;
  156.  
  157.    private is_eq_helper(s:STR,i:INT):BOOL is
  158.       -- Matt Kennel, INLS.  The reason for this
  159.       -- function's existence is that it will be overridden
  160.       -- by "memcmp" in MACROS.
  161.       loop if elt!/=s.aelt! then return false end; end;
  162.       return true;
  163.    end;
  164.     
  165.    is_eq(s:SAME):BOOL
  166.       -- True if `s' equals self. Either may be void. MBK.
  167.       post result = (initial(self).str.is_eq(s.str)) is
  168.       s1,s2:INT;
  169.       if void(self) then s1 := -1; else s1 := loc; end;
  170.       if void(s) then s2 := -1; else s2 := s.loc; end;
  171.      -- -1 is an otherwise illegal value.
  172.      -- We thus distinguish 'void' from 0 length FSTR.
  173.       if s1 /= s2 then return false end; 
  174.       return is_eq_helper(s,s1); -- MACROized.
  175.    end;
  176.    
  177.    is_eq(s:STR):BOOL is
  178.       -- so you can say `` if FSTR = "blabitty blah blah blah" '' 
  179.       s1,s2:INT;
  180.       if void(self) then s1 := -1; else s1 := loc; end;
  181.       if void(s) then s2 := -1; else s2 := s.size; end;
  182.      -- -1 is an otherwise illegal value.
  183.      -- We thus distinguish 'void' from 0 length FSTR.
  184.       if s1 /= s2 then return false end; 
  185.       return is_eq_helper(s,s1); -- MACROized.
  186.     end;
  187.    
  188. --   is_eq(s:SAME):BOOL is
  189. --      -- True if `s' equals self. Either may be void.
  190. --      if s.size/=size then return false end;
  191. --      loop if elt!/=s.elt! then return false end end; 
  192. --      return true end;
  193.  
  194.    is_neq(s:SAME):BOOL is
  195.       -- True if `s' is not equal to self. Either may be void.
  196.       return ~is_eq(s) end;
  197.    
  198.    is_lt(s:SAME):BOOL is
  199.       -- True if self is lexicographically before `s'.
  200.       -- Void is before everything else.
  201.       if size=0 then
  202.      if s.size/=0 then return true else return false end end;
  203.       if s.size=0 then return false end;
  204.       loop c::=elt!; sc::=s.elt!;
  205.      if c.is_gt(sc) then return false
  206.      elsif c.is_lt(sc) then return true end end;
  207.       if size<s.size then return true 
  208. --    else return false end end;                                                -- NLP
  209.       end; return false; end;                                                   -- NLP
  210.    
  211.    hash:INT is
  212.       -- Keep It Simple, Stupid.
  213.       if void(self) then return 0 end;
  214.       if (length = 0) then return 0 end;
  215.     
  216.       i::= length-1;
  217.       r:INT:=532415.uplus([i].int);
  218.      -- 532415 = 'A' * (2^13-1)
  219.       i := i-1;
  220.       loop while!(i>=0);
  221.      r := (r.utimes(1664525)).uplus(1013904223).uplus([i].int);      
  222.      i := i-1
  223.       end;
  224.       return r;
  225.    end;
  226.  
  227.    hash0:INT is
  228.       -- An inexpensive to compute hash function of self.
  229.       -- Gives an INT with rightmost 24 bits.   Also gives
  230.       -- lousy hash functions.
  231.       -- Void gives 0.
  232.       r::=0;
  233.       loop i::=ind!; r:=r.bxor([i].int.lshift(i.band(15))) end;
  234.       return r end;
  235.  
  236.    append_file(nm:STR):SAME is
  237.       -- Open the file named `nm' in the current directory, append
  238.       -- its contents to self, close the file, and return the new
  239.       -- buffer. Do nothing if the file cannot be opened.
  240.       fd::=C_STR::c_str_file_open(nm);
  241.       if fd<0 then return self end;
  242.       sz::=C_STR::c_str_file_size(fd);
  243.       if sz=0 then return self end;
  244.       r:SAME;
  245.       bst:INT;
  246.       if void(self) then 
  247.      r:=new(sz); bst:=0; r.loc:=sz; 
  248.       elsif sz<=asize-loc then 
  249.      r:=self; bst:=loc; r.loc:=loc+sz;
  250.       else
  251.      r:=new((2*asize).max(loc+sz)); bst:=loc;
  252.      r.acopy(self); r.loc:=loc+sz; end;
  253.       C_STR::c_str_file_in_fstr(fd,r,0,sz,bst);
  254.       C_STR::c_str_file_close(fd);
  255.       return r end;
  256.  
  257.    append_file_range(nm:STR,st,sz:INT):SAME is
  258.       -- Open the file named `nm' in the current directory, append
  259.       -- at most `sz' characters starting at `st' to self (only as 
  260.       -- many as are there), close the file, and return the new buffer. 
  261.       -- Do nothing if the file cannot be opened. 
  262.       fd::=C_STR::c_str_file_open(nm);
  263.       if fd<0 then return self end;
  264.       fsz::=C_STR::c_str_file_size(fd);
  265.       if fsz=0 then return self end;
  266.       asz::=(fsz-st).min(sz);    -- Actual size of range.
  267.       r:SAME;
  268.       bst:INT;
  269.       if void(self) then 
  270.      r:=new(asz); bst:=0; r.loc:=asz; 
  271.       elsif asz<=asize-loc then 
  272.      r:=self; bst:=loc; r.loc:=loc+asz;
  273.       else
  274.      r:=new((2*asize).max(loc+asz)); bst:=loc;
  275.      r.acopy(self); r.loc:=loc+asz; end;
  276.       C_STR::c_str_file_in_fstr(fd,r,st,asz,bst);
  277.       C_STR::c_str_file_close(fd);
  278.       return r end;
  279.  
  280.    is_upper:BOOL is
  281.       -- True if each alphabetic character of self is upper case.
  282.       -- Self may be void.
  283.       loop if elt!.is_upper.not then return false end end; 
  284.       return true end;
  285.  
  286.    is_lower:BOOL is
  287.       -- True if each alphabetic character of self is lower case.
  288.       -- Self may be void.
  289.       loop if elt!.is_lower.not then return false end end; 
  290.       return true end;  
  291.    
  292.    head(i:INT):SAME 
  293.       -- The first `i' characters of self.
  294.       -- Self may be void if i=0.
  295.       pre i.is_bet(0,size) is
  296.       if void(self) then return void end;
  297.       r::=#SAME(i); r.acopy(self); r.loc := i; return r end;
  298.  
  299.    tail(i:INT):SAME 
  300.       -- The last `i' characters of self.
  301.       -- Self may be void if i=0.
  302.       pre i.is_bet(0,size) post result.size = i is
  303.       if void(self) then return self end;
  304.       r::=#SAME(i); r.acopy(0,i,asize-i,self); r.loc := i; return r end;
  305.    
  306.    substring(beg,num:INT):SAME 
  307.       -- The substring with `num' charcters whose first character has 
  308.       -- index `beg'. Self may be void if beg=0 and num=0.
  309.       pre num>=0 and beg.is_bet(0,size-num) post result.size = num is
  310.       if void(self) then return void end;
  311.       r::=#SAME(num); r.acopy(0,num,beg,self); r.loc := num; return r end;
  312.  
  313.    separate!(s:FSTR!):FSTR is
  314.       -- On the first iteration just outputs `s', on successive 
  315.       -- iterations it outputs self followed by `s'. Useful for 
  316.       -- forming lists, 
  317.       -- Eg: loop #OUT + ", ".separate!(a.elt!) end;
  318.       yield s; loop yield self + s end end;
  319.  
  320. end; -- class FSTR
  321.  
  322. -------------------------------------------------------------------
  323.  
  324. class TEST_FSTR is
  325.    include TEST;
  326.    
  327.    main is
  328.       class_name("FSTR");
  329.       s ::= #FSTR;
  330.       test("length",s.length.str,"0");
  331.       s := s+'c';
  332.       test("length2",s.length.str,"1");
  333.       test("+char, str",s.str,"c");
  334.       s.clear;
  335.       test("clear",s.str,"");
  336.       s := s+"TEST";
  337.       test("plus s",s.str,"TEST");
  338.       s := s+2;
  339.       test("plus int",s.str,"TEST2");
  340.       s := s+3.0;
  341.       test("plus float",s.str,"TEST23");
  342.       test("is_eq",s.is_eq("TEST23").str,"true");
  343.       s.clear;
  344.       s := s+"test";
  345.       s_test ::= s.copy;
  346.       test("copy",(s_test).str,"test");
  347.       test("is_eq 2",(s_test.is_eq("test")).str,"true");
  348.       test("is_eq 3",(s_test.is_eq("no_test")).str,"false");
  349. --Forgotten what the sugar is!  test("is_neq",(s_test/=("test")).str,"true");
  350. --      test("is_eq",(s_test=("no_test")).str,"false");
  351. --      test("hash"
  352. --   test("append_file"  append_file_range
  353.       s.clear;
  354.       s := s+"TEST";
  355.       s_TEST ::= s.copy;
  356.       test("copy 2",s_TEST.str,"TEST");
  357.       s_TEST := s_TEST+"TEST OF A LONGER STRING THAT SHOULD DOUBLE";
  358.       test("plus str",s_TEST.str,"TESTTEST OF A LONGER STRING THAT SHOULD DOUBLE");
  359.       s := s+s;
  360.       test("plus fstr",s.str,"TESTTEST");
  361.       s.clear;
  362.       s := s+"TEST"+500;
  363.       test("plus int2",s.str,"TEST500");
  364.       s.clear;     s := s+"TEST"+(-1000);
  365.       test("plus int2",s.str,"TEST-1000");
  366.       s.clear;     s := s+"TEST"+463.479;
  367.       test("plus float2",s.str,"TEST463.479");
  368.       s.clear;     s := s+"TEST"+(-12463.479);
  369.       test("plus float3",s.str,"TEST-12463.5");
  370.       s_TEST.clear;      s_TEST := s_TEST+"TEST";
  371.       s_test.clear;      s_test := s_test+"test";
  372.       test("is_upper",s_TEST.is_upper.str,"true");
  373.       test("is_upper",s_test.is_upper.str,"false");
  374.       test("is_lower",s_TEST.is_lower.str,"false");
  375.       test("is_lower",s_test.is_lower.str,"true");
  376.       finish;
  377.       end;
  378.  
  379. end; -- class TEST_FSTR
  380.  
  381. -------------------------------------------------------------------
  382.  
  383.  
  384.  
  385.  
  386.  
  387.