home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / sa104os2.zip / SATHR104.ZIP / SATHER / LIBRARY / STR.SA < prev    next >
Text File  |  1995-02-05  |  30KB  |  791 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. -- str.sa: Strings.
  9. -------------------------------------------------------------------
  10. class STR < $IS_EQ{STR}, $IS_LT{STR}, $HASH is 
  11.    -- Strings.
  12.    -- Strings are represented as arrays of characters. Every character
  13.    -- is significant. 
  14.    -- 
  15.    -- References: Gonnet and Baeza-Yates, "Handbook of Algorithms and
  16.    -- Data Structures", Addison Wesley, 1991.
  17.    
  18.    private include AREF{CHAR} aget->aget; 
  19.       -- Make modification routines private.
  20.  
  21.    private shared buf:FSTR;    -- Character buffer.
  22.  
  23.    create:SAME is
  24.       -- An empty string. (Occasionally useful in constructs like 
  25.       -- `#STR + foo'). 
  26.       return "" end;
  27.    
  28.    create_from_file(nm:STR):SAME is
  29.       -- Open the file named `nm' in the current directory, create a
  30.       -- string containing its contents and then close the file. Return
  31.       -- void if there is no such file.
  32.       fd::=C_STR::c_str_file_open(nm);
  33.       if fd<0 then return void end;
  34.       sz::=C_STR::c_str_file_size(fd);
  35.       r::=new(sz);
  36.       C_STR::c_str_file_in_str(fd,r,0,sz);
  37.       C_STR::c_str_file_close(fd);
  38.       return r end;
  39.  
  40.    create_from_file_range(nm:STR,st,sz:INT):SAME is
  41.       -- Open the file named `nm' in the current directory, create a
  42.       -- string containing `sz' characters starting at `st'. Fill in
  43.       -- the remainder with '\0' if the file is too small. Return
  44.       -- void if there is no such file.
  45.       fd::=C_STR::c_str_file_open(nm);
  46.       if fd<0 then return void end;
  47.       fsz::=C_STR::c_str_file_size(fd);
  48.       r::=new(sz);
  49.       if st+sz<fsz then C_STR::c_str_file_in_str(fd,r,st,sz);
  50.       else C_STR::c_str_file_in_str(fd,r,st,fsz-st) end;
  51.       C_STR::c_str_file_close(fd);
  52.       return r end;
  53.  
  54.    create_from_c_string(s:EXT_OB):SAME is
  55.       -- Create a Sather string from a C pointer.  Needless to say,
  56.       -- use this with caution.
  57.       if void(s) then return void end;
  58.       len::=C_STR::strlen(s);
  59.       r::=new(len);
  60.       ext::=C_STR::strcpy(r,s);
  61.       return r;
  62.       end;
  63.  
  64.    create_from_memory_area(s:EXT_OB,len:INT):SAME is
  65.       -- Create a Sather string from a memory area of size
  66.       -- 'len' bytes starting at 's'.  Needless to say,
  67.       -- use this with caution.
  68.       if void(s) or len<=0 then return void end;
  69.       r::=new(len);
  70.       ext::=C_STR::memcpy(r,s,len);
  71.       return r;
  72.       end;
  73.    
  74.    size:INT is
  75.       -- The number of characters in self. 0 if self is void. 
  76. --    if void(self) then return 0 else return asize end end;                    -- NLP
  77.       if void(self) then return 0 end; return asize; end;                       -- NLP
  78.  
  79.    length:INT is
  80.       -- The number of characters in self. 0 if self is void.
  81.       -- Another name for `size'.
  82. --    if void(self) then return 0 else return asize end end;                    -- NLP
  83.       if void(self) then return 0 end; return asize; end;                       -- NLP
  84.  
  85.    char(i:INT):CHAR
  86.       -- The character at index `i' of self.
  87.       pre i.is_bet(0,asize-1) is
  88.       return [i] end;
  89.    
  90.    elt!:CHAR is
  91.       -- Yield the characters of self in order. 
  92.       -- Self may be void.
  93.       if ~void(self) then loop yield aelt! end end end;
  94.    
  95.    elt!(beg:INT):CHAR is
  96.       -- Yield the characters of self in order starting at `beg'.
  97.       -- Self may be void.
  98.       if ~void(self) then loop yield aelt!(beg) end end end;
  99.    
  100.    ind!:INT is
  101.       -- Yield the indices of the characters of self in order. 
  102.       -- Self may be void.
  103.       if ~void(self) then loop yield aind! end end end;   
  104.  
  105.    acopyn(s:FSTR,n:INT) pre n <= s.length is 
  106.       -- copy "n" chars from "s" into "self".
  107.       loop aset!(s[n.times!]) end;
  108.    end;
  109.     
  110.    acopyn(s:STR,n:INT) pre n <= s.length is 
  111.       -- copy "n" chars from "s" into "self".
  112.       loop aset!(s[n.times!]) end;
  113.    end;
  114.    
  115.    from_fstr(s:FSTR):SAME is
  116.       -- A new string with the characters currently held in `s'.
  117.       -- Returns empty string if emtpy.  Modified MBK.
  118.       sz ::= s.size; -- save it.
  119.       if sz=0 then return "" end;
  120.       r::=new(sz);
  121.       r.acopyn(s,sz);
  122. --      loop r.aset!(s.elt!) end;
  123.       return r end;
  124.  
  125.    fstr:FSTR is
  126.       -- An FSTR with the same characters as self.
  127. --      if size=0 then return void; end;
  128. --      r::=#FSTR(size);
  129. --      loop r:=r.push(elt!); end;
  130. --      return r;
  131. --      end;
  132.       return #FSTR(self); end;
  133.  
  134.    plus(s:SAME):SAME is
  135.       -- A new string obtained by appending `s' to self.
  136.       -- Either self or `s' may be void.  Sped up, MBK.
  137. --    if size=0 then return s                                                   -- NLP
  138. --    else                                                                      -- NLP
  139. --       sz ::= s.size;                                                         -- NLP
  140. --       if sz=0 then return self                                               -- NLP
  141. --       else r::=new(asize+sz); r.acopyn(self,asize);                          -- NLP
  142. --       r.acopy(asize,s); return r end                                         -- NLP
  143. --    end;                                                                      -- NLP
  144.       if size=0 then return s; end;                                             -- NLP
  145.       sz ::= s.size;                                                            -- NLP
  146.       if sz=0 then return self; end;                                            -- NLP
  147.       r::=new(asize+sz); r.acopyn(self,asize);                                  -- NLP
  148.       r.acopy(asize,s); return r;                                               -- NLP
  149.     end;
  150.    
  151.    plus(b:BOOL):SAME is
  152.       -- A new string obtained by appending the value of `b'
  153.       -- to self. Self may be void.
  154.       if void(self) then 
  155.      if b then return "true" else return "false" end
  156.       elsif b then return self+"true" 
  157. --    else return self+"false" end end;                                         -- NLP
  158.       end; return self+"false"; end;                                            -- NLP
  159.  
  160.    plus(c:CHAR):SAME is
  161.       -- A new string obtained by appending `c' to self.
  162.       -- Self may be void.
  163.       r:SAME;
  164.       if void(self) then r:=new(1)
  165.       else r:=new(asize+1); r.acopy(self) end;
  166.       r[size]:=c; return r end;
  167.  
  168.    plus(i:INT):SAME is
  169.       -- A new string obtained by appending `i' to self.
  170.       -- Self may be void.
  171.       buf.clear; if ~void(self) then buf:=buf+self end;
  172.       buf:=i.str_in(buf); return from_fstr(buf) end;
  173.  
  174.    plus(f:FLT):SAME is
  175.       -- A new string obtained by appending `f' to self.
  176.       -- Self may be void.
  177.       buf.clear; if ~void(self) then buf := buf+self; end;
  178.       return(from_fstr(buf+(f.str))); end;
  179.  
  180.    plus(f:FLTD):SAME is
  181.       -- A new string obtained by appending `f' to self.
  182.       -- Self may be void.
  183.       buf.clear; if ~void(self) then buf := buf+self; end;
  184.       return(from_fstr(buf+(f.str))); end;
  185.  
  186.    plus(s:FSTR):SAME is
  187.       -- A new string obtained by appending `s' to self.
  188.       -- Either self or `s' may be void.
  189.       if s.size=0 then return self
  190.       elsif size=0 then return s.str
  191. --    else r::=new(size+s.size);                                                -- NLP
  192.       end; r::=new(size+s.size);                                                -- NLP
  193.      r.acopy(self); loop r.aset!(size,s.elt!) end;
  194. --       return r end end;                                                      -- NLP
  195.          return r; end;                                                         -- NLP
  196.  
  197.    append(s:SAME):SAME is
  198.       -- A new string obtained by appending `s' to self.
  199.       -- Either self or `s' may be void.    
  200.       return plus(s) end;
  201.    
  202.    append(s1,s2:SAME):SAME is
  203.       -- A new string obtained by appending `s1' and `s2' to self.
  204.       -- Any of the strings may be void.
  205.       if size=0 then return s1+s2
  206.       elsif s1.size=0 then return self+s2
  207.       elsif s2.size=0 then return self+s1
  208. --    else r::=new(asize+s1.asize+s2.asize);                                    -- NLP
  209.       end; r::=new(asize+s1.asize+s2.asize);                                    -- NLP
  210.      r.acopy(self); r.acopy(asize,s1);
  211. --       r.acopy(asize+s1.asize,s2); return r end end;                          -- NLP
  212.          r.acopy(asize+s1.asize,s2); return r; end;                             -- NLP
  213.  
  214.    append(s1,s2,s3:SAME):SAME is
  215.       -- A new string obtained by appending `s1', `s2', and `s3' to self.
  216.       -- Any of the strings may be void.
  217.       if size=0 then return s1.append(s2,s3)
  218.       elsif s1.size=0 then return self.append(s2,s3)
  219.       elsif s2.size=0 then return self.append(s1,s3)
  220.       elsif s3.size=0 then return self.append(s1,s2)     
  221. --    else r::=new(asize+s1.asize+s2.asize+s3.asize);                           -- NLP
  222.       end; r::=new(asize+s1.asize+s2.asize+s3.asize);                           -- NLP
  223.      r.acopy(self); r.acopy(asize,s1);
  224.      r.acopy(asize+s1.asize,s2); r.acopy(asize+s1.asize+s2.asize,s3);
  225. --       return r end end;                                                      -- NLP
  226.          return r; end;                                                         -- NLP
  227.  
  228.    append(s1,s2,s3,s4:SAME):SAME is
  229.       -- A new string obtained by appending `s1', `s2', `s3', and
  230.       -- `s4' to self. Any of the strings may be void.
  231.       if size=0 then return s1.append(s2,s3,s4)
  232.       elsif s1.size=0 then return self.append(s2,s3,s4)
  233.       elsif s2.size=0 then return self.append(s1,s3,s4)
  234.       elsif s3.size=0 then return self.append(s1,s2,s4)     
  235.       elsif s4.size=0 then return self.append(s1,s2,s3)          
  236. --    else r::=new(asize+s1.asize+s2.asize+s3.asize+s4.asize);                  -- NLP
  237.       end; r::=new(asize+s1.asize+s2.asize+s3.asize+s4.asize);                  -- NLP
  238.      r.acopy(self); r.acopy(asize,s2);  r.acopy(asize+s1.asize,s2);
  239.      r.acopy(asize+s1.asize+s2.asize,s3);
  240.      r.acopy(asize+s1.asize+s2.asize+s3.asize,s4);
  241. --       return r end end;                                                      -- NLP
  242.          return r; end;                                                         -- NLP
  243.  
  244.    str:STR is
  245.       return self; end;
  246.  
  247.    pretty:STR is
  248.       -- Pretty print self. This surrounds the string with 
  249.       -- a pair of double quotes. Any non-printing characters or double 
  250.       -- quotes are replaced by their special codes or the octal 
  251.       -- representation.
  252.       buf.clear; buf:=buf+'\"';
  253.       loop c::=elt!;
  254.      if c.is_print and c/='\"' and c/='\\' then buf:=buf+c
  255.      else buf:=buf + '\\';
  256.         case c
  257.         when '\a' then buf:=buf+'a'  when '\b' then buf:=buf+'b'
  258.         when '\f' then buf:=buf+'f'  when '\n' then buf:=buf+'n'
  259.         when '\r' then buf:=buf+'r'  when '\t' then buf:=buf+'t'
  260.         when '\v' then buf:=buf+'v'  when '\\' then buf:=buf+'\\'
  261.         when '\"' then buf:=buf+'\"'
  262.         else s::=c.int.octal_str; 
  263.            buf:=buf+s.tail(s.size-2) end end end;
  264.       buf:=buf+'\"'; return buf.str end;
  265.  
  266.    as_literal:STR is
  267.       -- Returns the string described by self assuming it is in "string
  268.       -- literal" form. This means it must begin and end with double
  269.       -- quotes and must not contain any non-printing characters.
  270.       -- The returned string eliminates the initial and final double 
  271.       -- quotes and converts any escape codes to the corresponding 
  272.       -- characters. self may consist of several double-quote enclosed
  273.       -- strings separated by whitespace. In this case the strings are 
  274.       -- concatenated together. If self is not in correct string literal
  275.       -- format, returns void.
  276.       if void(self) or [0]/='\"' or [size-1]/='\"' then return void end;
  277.       buf.clear; esc,oct,qt:BOOL; oval:INT;
  278.       loop c::=aelt!(1,size-2);
  279.      if qt then        -- We're between concatted strings.
  280.         if c='\"' then qt:=false 
  281.         elsif ~c.is_space then return void end; 
  282.      else
  283.         if oct then        -- we're in an octal escape code
  284.            if c.is_octal_digit then oval:=oval*8+c.octal_digit_value 
  285.            else buf:=buf+oval.char; oct:=false; esc:=false end end;
  286.         if ~oct then
  287.            if esc then        -- we've seen only a '\'
  288.           case c
  289.           when 'a' then buf:=buf+'\a'; esc:=false
  290.           when 'b' then buf:=buf+'\b'; esc:=false
  291.           when 'f' then buf:=buf+'\f'; esc:=false
  292.           when 'n' then buf:=buf+'\n'; esc:=false
  293.           when 'r' then buf:=buf+'\r'; esc:=false  
  294.           when 't' then buf:=buf+'\t'; esc:=false
  295.           when 'v' then buf:=buf+'\v'; esc:=false  
  296.           when '\\' then buf:=buf+'\\'; esc:=false
  297.           when '\"' then buf:=buf+'\"'; esc:=false  
  298.           when '\'' then buf:=buf+'\''; esc:=false
  299.           when 0,1,2,3,4,5,6,7 then 
  300.              oct:=true; oval:=c.octal_digit_value
  301.           else return void end; -- illegal escape code
  302.            elsif c='\\' then esc:=true
  303.            elsif c='\"' then qt:=true
  304.            elsif c.is_print then buf:=buf+c
  305.            else return void end;  -- Illegal character
  306.         end end end;
  307.       if ~qt then return void -- Must close internal quotes.
  308.       elsif oct then buf:=buf+oval.char -- Ended with octal code.
  309.       elsif esc then return void end; -- Ended with '\'
  310.       return buf.str end;
  311.    
  312.    is_empty:BOOL is
  313.       -- True if self has no characters. 
  314.       -- Self may be void.
  315.       return (void(self)) or (asize=0) end;
  316.    
  317.    private is_eq_helper(s:SAME,i:INT):BOOL is
  318.       -- Matt Kennel, INLS.  The reason for this
  319.       -- function's existence is that it will be overridden
  320.       -- by "memcmp" in MACROS.
  321.       loop if aelt!/=s.aelt! then return false end; end;
  322.       return true;
  323.    end;
  324.     
  325.    is_eq(s:SAME):BOOL is
  326.       -- True if `s' equals self. Either may be void.
  327.       if void(self) then
  328.      if void(s) then return true
  329.      elsif s.asize=0 then return true
  330.      else return false end;
  331.       elsif void(s) then 
  332.      if asize=0 then return true else return false end
  333.       elsif asize/=s.asize then return false 
  334. --    else                                                                      -- NLP
  335.       end;                                                                      -- NLP
  336.      return is_eq_helper(s,asize);
  337. --    end;                                                                      -- NLP
  338.    end;
  339.  
  340.    is_neq(s:SAME):BOOL is
  341.       -- True if `s' is not equal to self. Either may be void.
  342.       return ~is_eq(s) end;
  343.    
  344.    is_lt(s:SAME):BOOL is
  345.       -- True if self is lexicographically before `s'.
  346.       -- Void is taken to be before everything else.
  347.       if size=0 then 
  348.      if s.size/=0 then return true else return false end
  349.       elsif s.size=0 then return false
  350.       else
  351.      loop c::=aelt!; sc::=s.aelt!;
  352.         if c.is_gt(sc) then return false
  353.         elsif c.is_lt(sc) then return true end end;
  354.      if size<s.size then return true 
  355. --       else return false end end end;                                         -- NLP
  356.          end; end; return false; end;                                           -- NLP
  357.  
  358.    is_leq(s:SAME):BOOL is
  359.       -- True if self is lexicographically before `s' or equal to it.
  360.       -- Either may be void.
  361.       if size=0 then return true
  362.       elsif s.size=0 then return false
  363.       else
  364.      loop c::=aelt!; sc::=s.aelt!;
  365.         if c.is_gt(sc) then return false
  366.         elsif c.is_lt(sc) then return true end end;
  367.      if size<=s.size then return true
  368. --       else return false end end end;                                         -- NLP
  369.          end; end; return false; end;                                           -- NLP
  370.  
  371.    is_gt(s:SAME):BOOL is
  372.       -- True if `s' is lexicographically before self.
  373.       -- Either may be void.
  374.       return s.is_lt(self) end;
  375.  
  376.    is_geq(s:SAME):BOOL is
  377.       -- True if `s' is lexicographically before self or equal to it.
  378.       -- Either may be void.
  379.       return s.is_leq(self) end;      
  380.  
  381.    is_upper:BOOL is
  382.       -- True if each alphabetic character of self is upper case.
  383.       -- Self may be void.
  384.       loop if ~elt!.is_upper then return false end end; 
  385.       return true end;
  386.  
  387.    is_lower:BOOL is
  388.       -- True if each alphabetic character of self is lower case.
  389.       -- Self may be void.
  390.       loop if ~elt!.is_lower then return false end end; 
  391.       return true end;  
  392.    
  393.    upper:SAME is
  394.       -- A copy of self with each character in upper case.
  395.       -- Self may be void.
  396.       if void(self) then return void end;
  397.       r::=new(asize); 
  398.       loop r.aset!(aelt!.upper) end; return r end;
  399.  
  400.    lower:SAME is
  401.       -- A copy of self with each character in lower case.
  402.       -- Self may be void.
  403.       if void(self) then return void end;
  404.       r::=new(asize); 
  405.       loop r.aset!(aelt!.lower) end; return r end;
  406.    
  407.    capitalize:SAME is
  408.       -- A copy of self with each word capitalized.
  409.       -- Self may be void.
  410.       if void(self) then return void end;
  411.       r::=new(asize);
  412.       sp::=true;        -- True if previous char was punct.
  413.       loop c::=aelt!; 
  414.      if sp then c:=c.upper end;
  415.      if c.is_punct or c.is_space then sp:=true else sp:=false end;
  416.      r.aset!(c) end; 
  417.       return r end;
  418.  
  419.    head(i:INT):SAME 
  420.       -- The first `i' characters of self.
  421.       -- Self may be void if i=0.
  422.       pre i.is_bet(0,size) is
  423.       if void(self) then return void end;
  424.       r::=new(i); r.acopy(self); return r end;
  425.    
  426.    tail(i:INT):SAME 
  427.       -- The last `i' characters of self.
  428.       -- Self may be void if i=0.
  429.       pre i.is_bet(0,size) is
  430.       if void(self) then return self end;
  431.       r::=new(i); r.acopy(0,i,asize-i,self); return r end;     
  432.    
  433.    substring(beg,num:INT):SAME 
  434.       -- The substring with `num' charcters whose first character has 
  435.       -- index `beg'. Self may be void if beg=0 and num=0.
  436.       pre num>=0 and beg.is_bet(0,size-num) is
  437.       if void(self) then return void end;
  438.       r::=new(num); r.acopy(0,num,beg,self); return r end;
  439.  
  440.    reverse:SAME is
  441.       -- A string whose characters are the reverse of those in self.
  442.       -- Self may be void.
  443.       if void(self) then return void end;
  444.       r::=new(asize); 
  445.       loop r.aset!(aelt!(asize-1,asize,-1)) end;
  446.       return r end;
  447.    
  448.    repeat(i:INT):SAME
  449.       -- Self repeated `i' times. Self may be void.
  450.       pre i>=0 is 
  451.       if void(self) then return void end;
  452.       r::=new(asize*i);
  453.       loop r.acopy(0.step!(i,asize),self) end; return r end;
  454.  
  455.    contains(c:CHAR):BOOL is
  456.       -- True if `c' appears in self. Self may be void.
  457.       loop if elt!=c then return true end end;
  458.       return false end;
  459.  
  460.    count(c:CHAR):INT is
  461.       -- The number of times `c' appears in self.
  462.       -- Self may be void.
  463.       r::=0; loop if elt!=c then r:=r+1 end end;
  464.       return r end;
  465.  
  466.    count(s:STR):INT is
  467.       -- The number of times a character in `s' appears in self.
  468.       -- Self may be void.
  469.       if void(self) or void(s) then return 0 end;
  470.       r::=0; loop if s.contains(elt!) then r:=r+1 end end;
  471.       return r end;
  472.    
  473.    search(c:CHAR):INT is
  474.       -- The index of the first appearance of `c' in self or -1 if absent.
  475.       -- Self may be void.
  476.       loop r::=ind!; if [r]=c then return r end end; 
  477.       return -1 end;
  478.  
  479.    search(c:CHAR,st:INT):INT is
  480.       -- The index of the first appearance of `c' at location `st' or
  481.       -- greater in self or -1 if absent.
  482.       -- Self may be void.
  483.       loop r::=st.upto!(size-1); if [r]=c then return r end end; 
  484.       return -1 end;
  485.    
  486.    replace(o,n:CHAR):SAME is
  487.       -- A new string with each occurance of `o' replaced by `n'.
  488.       -- Self may be void.
  489.       if void(self) then return void end;
  490.       r::=new(asize);
  491.       loop c::=aelt!; if c=o then c:=n end; 
  492.      r.aset!(c) end;
  493.       return r end;
  494.  
  495.    remove(c:CHAR):SAME is
  496.       -- Self with all occurances of `c' removed.
  497.       -- Self may be void.
  498.       if void(self) then return void end;
  499.       ns::=asize-count(c);
  500.       if ns=0 then return void end;
  501.       r::=new(ns);
  502.       loop sc::=aelt!; 
  503.      if ~(sc=c) then r.aset!(sc) end end;
  504.       return r end;
  505.    
  506.    contains_chars_from(s:STR):BOOL is
  507.       -- True if any of the characters in self are contained in `s'.
  508.       -- Either may be void.
  509.       loop if s.contains(elt!) then return true end end;
  510.       return false end;   
  511.    
  512.    count_chars_from(s:SAME):INT is
  513.       -- The number of characters in self which are contained in `s'.
  514.       -- Either may be void.
  515.       r::=0; loop if s.contains(elt!) then r:=r+1 end end; 
  516.       return r end;
  517.    
  518.    search_chars_from(s:SAME):INT is
  519.       -- The index of the first appearance in self of a character
  520.       -- contained in `s' or -1 if none.
  521.       -- Self or `s' may be void.
  522.       loop r::=ind!; if s.contains([r]) then return r end end; 
  523.       return -1 end;
  524.    
  525.    replace_chars_from(set:SAME,n:CHAR):SAME is
  526.       -- A new string with character contained in `set' replaced by 
  527.       -- `n'. Self may be void.
  528.       if void(self) then return void end;
  529.       r::=new(asize);
  530.       loop c::=aelt!; if set.contains(c) then c:=n end; 
  531.      r.aset!(c) end;
  532.       return r end;
  533.  
  534.    remove_chars_from(s:SAME):SAME is
  535.       -- Self with all characters which are contained in `s' removed.
  536.       -- Either may be void.
  537.       if void(self) then return void end;
  538.       if void(s) then return self end;
  539.       ns::=asize-count(s); if ns=0 then return self end;
  540.       r::=new(ns);
  541.       loop c::=aelt!; 
  542.      if ~s.contains(c) then r.aset!(c) end end;
  543.       return r end;      
  544.  
  545.    is_prefix(s:SAME):BOOL is
  546.       -- true is s is a prefix of self.
  547.       if length<s.length then return false; end;
  548.       loop if (elt!/=s.elt!) then return false; end; end;
  549.       return true; end;
  550.  
  551.    mismatch(s:SAME):INT is
  552.       -- The index of the first character of self which differs from `s'.
  553.       -- -1 if self is a prefix of `s'. Either may be void.
  554.       if void(self) then return -1 end;
  555.       if void(s) then return 0 end;
  556.       r:INT;
  557.       loop r:=ind!; if [r]/=s.aelt! then return r end end;
  558.       if r=asize-1 then return -1 end;
  559.       return r end;
  560.  
  561.    search(s:SAME):INT is
  562.       -- The index of the leftmost substring of self which matches `s'.
  563.       -- -1 if none. Uses simple algorithm which has good performance
  564.       -- unless the strings are special (eg. many repeated values).
  565.       -- Either string may be void. (Void matches void at 0).
  566.       if void(s) then return 0 end;
  567.       if void(self) then return -1 end;
  568.       loop r::=0.upto!(asize-s.asize); match::=true;
  569.      loop if aelt!(r)/=s.aelt! then 
  570.         match:=false; break! end end;
  571.      if match=true then return r end end; 
  572.       return -1 end;
  573.    
  574.    cursor:STR_CURSOR is
  575.       -- A cursor into self.
  576.       return STR_CURSOR::create(self) end;
  577.    
  578.    hash1:INT is
  579.       -- An inexpensive to compute hash function of self.
  580.       -- Gives an INT with rightmost 24 bits. 
  581.       -- Void gives 0.
  582. --      r::=0; loop i::=ind!; 
  583. --     r:=r.bxor([i].int.lshift(i.band(15))) end;
  584. --      return r end;
  585. -- code changed by MBK.  This has to go fast,
  586. -- it's frequently called by the compiler code.
  587. -- Guess what.  The above hash function really sucks rocks.
  588. -- we get lots and lots of clustering.  The compiler's
  589. -- run time is dependent on how fast and how good 
  590. -- you can make string hashing
  591. -- go.  This next one isn't great either.  We should make one
  592. -- as strong as reasonable random number generators.
  593. -- Those numbers are just 'random' integers between 0 and 2^24-1
  594. -- that I picked up behind a dark alley.
  595. -- 
  596.       if void(self) then return 0 end;
  597.       r::=11764026;
  598.       i::= asize-1;
  599.       loop
  600.      while!(i>=0);
  601.      c:INT := [i].int;
  602.      case (r+c).band(7)
  603.      when 0 then r:=r.bxor(11522134) + c.bxor(15272649);
  604.      when 1 then r:=r.bxor(9981388)  + c.bxor(12787561);
  605.      when 2 then r:=r.bxor(15610134) + c.bxor(4403230);
  606.      when 3 then r:=r.bxor(14196234) + c.bxor(796322);
  607.      when 4 then r:=r.bxor(8840397)  + c.bxor(12349404);
  608.      when 5 then r:=r.bxor(1542914)  + c.bxor(5506856);
  609.      when 6 then r:=r.bxor(10970939) + c.bxor(10613913);
  610.      when 7 then r:=r.bxor(6979311)  + c.bxor(12690462);
  611.      end; 
  612.          i := i-1;
  613.       end;
  614.       return r.band(16777215); -- 2^24-1
  615.    end;
  616.  
  617.    private const coeff1:ARRAY{INT} := |11522134,9981388,15610134,14196234,
  618.      8840397,1524914,10970939,6979311|;
  619.    private const coeff2:ARRAY{INT} := |15272649,12787561,4403230,796322,
  620.      12349404,5506856,10613913,12690462|;
  621.    
  622.    hash2:INT is
  623. -- code changed by MBK.  This has to go fast,
  624. -- it's frequently called by the compiler code.
  625. -- Guess what.  The original hash function really sucks rocks.
  626. -- we get lots and lots of clustering.  The compiler's
  627. -- run time is dependent on how fast and how good 
  628. -- you can make string hashing
  629. -- go.  This next one isn't great either.  We should make one
  630. -- as strong as reasonable random number generators.
  631. -- Those numbers are just 'random' integers between 0 and 2^24-1
  632. -- that I picked up behind a dark alley.
  633.       if void(self) then return 0 end;
  634.       r::=11764026;
  635.       i::= asize-1;
  636.       loop
  637.      while!(i>=0);
  638.      c:INT := [i].int;
  639.      z:INT := (r+c).band(7);
  640.      r := r.bxor(coeff1[z]) + c.bxor(coeff2[z]);
  641.          i := i-1;
  642.       end;
  643.       return r.band(16777215); -- 2^24-1
  644.    end;
  645.  
  646.    hash3: INT is
  647.       -- An not-quite-so inexpensive to compute hash function of self.  
  648.       -- Void gives 0.  Changed from original, MBK.
  649.       -- Original gave very yucky collision avalanching in the compiler
  650.       -- implementation.  I'm sick of half-assed hash functions.
  651.       
  652.       if void(self) then return 0 end;
  653.  
  654.       i::= asize-1;
  655.       r:INT:=532415.uplus([i].int);
  656.      -- 532415 = 'A' * (2^13-1)
  657.       i := i-1;
  658.       loop while!(i >= 3);
  659.      fourchars :INT:= ([i].int).lshift(24);
  660.      fourchars := fourchars.bor(([i-1].int).lshift(16));
  661.      fourchars := fourchars.bor(([i-2].int).lshift(8));
  662.      fourchars := fourchars.bor([i-3].int);
  663.      r := (r.utimes(1664525)).uplus(1013904223).uplus(fourchars); 
  664.      -- Motivated by Numerical Recipes in C, p. 284.  A linear
  665.      -- congruential PRNG plus 4 characters as the hash salt.
  666.      
  667.      -- r := (r.utimes(8191)).uplus([i].int); 
  668.      -- negative. That one was even worse than the original.
  669.      i := i-4;
  670.       end;
  671.       if (i < 0) then return r; end;
  672.       c:INT;
  673.       case i
  674.       when 2 then 
  675.      c := ([2].int).lshift(16).bor(
  676.           ([1].int).lshift(8).bor(
  677.           ([0].int)));
  678.       when 1 then
  679.      c := ([1].int).lshift(8).bor(([0].int));
  680.       when 0 then
  681.      c := ([0]).int;
  682.       end;
  683.       r := (r.utimes(1664525)).uplus(1013904223).uplus(c); 
  684.       return r;
  685.    end;
  686.  
  687.    hash:INT is
  688.       -- Keep It Simple, Stupid.
  689.       if void(self) then return 0 end;
  690.       if (asize = 0) then return 0 end;
  691.       i::= asize-1;
  692.       r:INT:=532415.uplus([i].int);
  693.      -- 532415 = 'A' * (2^13-1)
  694.       i := i-1;
  695.       loop while!(i>=0);
  696.      r := (r.utimes(1664525)).uplus(1013904223).uplus([i].int);      
  697.      i := i-1
  698.       end;
  699.       return r;
  700.    end;
  701.    
  702.    left(i:INT):SAME is
  703.       -- A string of at least `i' characters in which self 
  704.       -- is left-justified and padded with spaces on the right. 
  705.       -- Returns self if i<=size.
  706.       if i<=size then return self end;
  707.       if void(self) then return " ".repeat(i) end;
  708.       r::=new(i); r.acopy(self);
  709.       loop r.aset!(asize, ' ') end; 
  710.       return r end;
  711.  
  712.    right(i:INT):SAME is
  713.       -- A string of at least `i' characters in which self 
  714.       -- is right-justified and padded with spaces on the left. 
  715.       -- Returns self if i<=size.   
  716.       if i<=size then return self end;
  717.       if void(self) then return " ".repeat(i) end;
  718.       r::=new(i); r.acopy(i-asize,self);
  719.       loop r.aset!(0, i-asize, ' ') end;
  720.       return r end;
  721.  
  722.    center(i:INT):SAME is
  723.       -- A string of at least `i' characters in which self 
  724.       -- is centered and padded with spaces on the left and right. 
  725.       -- Returns self if i<=size.      
  726.       if i<=size then return self end;
  727.       if void(self) then return " ".repeat(i) end;
  728.       r::=new(i);      
  729.       lp::=(i-asize)/2;        -- Size of left padding.
  730.       r.acopy(lp,self);
  731.       loop r.aset!(0, lp, ' ') end;
  732.       loop r.aset!(lp+asize, ' ') end;
  733.       return r end;
  734.  
  735.    separate!(s:STR!):STR is
  736.       -- On the first iteration just outputs `s', on successive 
  737.       -- iterations it outputs self followed by `s'. Useful for 
  738.       -- forming lists, 
  739.       -- Eg: loop #OUT + ", ".separate!(a.elt!) end;
  740.       yield s; loop yield self + s end end;
  741.  
  742.    concat_all(a: ARRAY{SAME}): SAME is
  743.      -- Concatinate all array of STRING.  Separator is '\0'.
  744.      r: SAME;
  745.      l: INT := a.size;
  746.      loop i ::= 0.upto!(l - 2);
  747.         r :=  r  + a[i] + '\0';
  748.      end; -- loop
  749.      return r + a[l - 1];
  750.    end;
  751.  
  752. end; -- class STR
  753.  
  754. -------------------------------------------------------------------
  755. external class C_STR is
  756.    -- Interface to C functions supporting STR.
  757.    
  758.    c_str_file_open(s:STR):INT; -- Try to open the file named `s'
  759.       -- for reading and return the file descriptor. -1 for failure.
  760.    
  761.    c_str_file_size(fd:INT):INT;    -- The size in characters of the 
  762.       -- file described by descriptor `fd'.
  763.    
  764.    c_str_file_in_str(fd:INT,s:STR,st,sz:INT); -- Fill in the string `s' 
  765.       -- with the characters from the file described by `fd' starting
  766.       -- at character `st' and going for `sz' chars (which should be
  767.       -- the length of `s'). THIS SHOULD NOT BE CALLED OUTSIDE OF
  768.       -- STR (to avoid breaking the immutability property of strings). 
  769.    
  770.    c_str_file_in_fstr(fd:INT,s:FSTR,st,sz,bst:INT); -- Insert into 
  771.       -- the string buffer `s' characters from the file described by
  772.       -- `fd' starting at character `st' and going for `sz' chars. Start
  773.       -- inserting at character `bst' of the buffer (there must be
  774.       -- room!).   
  775.    
  776.    c_str_file_close(fd:INT);    -- Close the file described by the 
  777.       -- descriptor `fd'.
  778.  
  779.    c_str_create_astr(i:INT, s:STR): EXT_OB; -- Split concatinate
  780.       -- strings separated by '\0' into array of string in C.
  781.  
  782.    strlen(s:EXT_OB):INT;
  783.    strcpy(s1:STR,s2:EXT_OB):EXT_OB;
  784.    memcpy(r:STR,s:EXT_OB,i:INT):EXT_OB;
  785.    
  786. end; -- external class C_STR
  787.  
  788. -------------------------------------------------------------------
  789.  
  790.  
  791.