home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / fstranl.r < prev    next >
Text File  |  2002-01-18  |  7KB  |  261 lines
  1. /*
  2.  * File: fstranl.r
  3.  * String analysis functions: any,bal,find,many,match,upto
  4.  *
  5.  * str_anal is a macro for performing the standard conversions and
  6.  *  defaulting for string analysis functions. It takes as arguments the
  7.  *  parameters for subject, beginning position, and ending position. It
  8.  *  produces declarations for these 3 names prepended with cnv_. These
  9.  *  variables will contain the converted versions of the arguments.
  10.  */
  11. #begdef str_anal(s, i, j)
  12.    declare {
  13.       C_integer cnv_ ## i;
  14.       C_integer cnv_ ## j;
  15.       }
  16.  
  17.    abstract {
  18.       return integer
  19.       }
  20.  
  21.    if is:null(s) then {
  22.       inline {
  23.          s = k_subject;
  24.          }
  25.       if is:null(i) then inline {
  26.          cnv_ ## i = k_pos;
  27.          }
  28.       }
  29.    else {
  30.       if !cnv:string(s) then
  31.          runerr(103,s)
  32.       if is:null(i) then inline {
  33.          cnv_ ## i = 1;
  34.          }
  35.       }
  36.  
  37.    if !is:null(i) then
  38.       if cnv:C_integer(i,cnv_ ## i) then inline {
  39.          if ((cnv_ ## i = cvpos(cnv_ ## i, StrLen(s))) == CvtFail)
  40.             fail;
  41.          }
  42.       else
  43.          runerr(101,i)
  44.  
  45.  
  46.     if is:null(j) then inline {
  47.        cnv_ ## j = StrLen(s) + 1;
  48.        }
  49.     else if cnv:C_integer(j,cnv_ ## j) then inline {
  50.        if ((cnv_ ## j = cvpos(cnv_ ## j, StrLen(s))) == CvtFail)
  51.           fail;
  52.        if (cnv_ ## i > cnv_ ## j) {
  53.           register C_integer tmp;
  54.           tmp = cnv_ ## i;
  55.           cnv_ ## i = cnv_ ## j;
  56.           cnv_ ## j = tmp;
  57.           }
  58.        }
  59.     else
  60.        runerr(101,j)
  61.  
  62. #enddef
  63.  
  64.  
  65. "any(c,s,i1,i2) - produces i1+1 if i2 is greater than 1 and s[i] is contained "
  66. "in c and poseq(i2,x) is greater than poseq(i1,x), but fails otherwise."
  67.  
  68. function{0,1} any(c,s,i,j)
  69.    str_anal( s, i, j )
  70.    if !cnv:tmp_cset(c) then
  71.       runerr(104,c)
  72.    body {
  73.       if (cnv_i == cnv_j)
  74.          fail;
  75.       if (!Testb(StrLoc(s)[cnv_i-1], c))
  76.          fail;
  77.       return C_integer cnv_i+1;
  78.       }
  79. end
  80.  
  81.  
  82. "bal(c1,c2,c3,s,i1,i2) - generates the sequence of integer positions in s up to"
  83. " a character of c1 in s[i1:i2] that is balanced with respect to characters in"
  84. " c2 and c3, but fails if there is no such position."
  85.  
  86. function{*} bal(c1,c2,c3,s,i,j)
  87.    str_anal( s, i, j )
  88.    if !def:tmp_cset(c1,fullcs) then
  89.       runerr(104,c1)
  90.    if !def:tmp_cset(c2,lparcs) then
  91.       runerr(104,c2)
  92.    if !def:tmp_cset(c3,rparcs) then
  93.       runerr(104,c3)
  94.  
  95.    body {
  96.       C_integer cnt;
  97.       char c;
  98.  
  99.       /*
  100.        * Loop through characters in s[i:j].  When a character in c2
  101.        * is found, increment cnt; when a character in c3 is found, decrement
  102.        * cnt.  When cnt is 0 there have been an equal number of occurrences
  103.        * of characters in c2 and c3, i.e., the string to the left of
  104.        * i is balanced.  If the string is balanced and the current character
  105.        * (s[i]) is in c, suspend with i.  Note that if cnt drops below
  106.        *  zero, bal fails.
  107.        */
  108.       cnt = 0;
  109.       while (cnv_i < cnv_j) {
  110.          c = StrLoc(s)[cnv_i-1];
  111.          if (cnt == 0 && Testb(c, c1)) {
  112.             suspend C_integer cnv_i;
  113.             }
  114.          if (Testb(c, c2))
  115.             cnt++;
  116.          else if (Testb(c, c3))
  117.             cnt--;
  118.          if (cnt < 0)
  119.             fail;
  120.          cnv_i++;
  121.          }
  122.       /*
  123.        * Eventually fail.
  124.        */
  125.       fail;
  126.       }
  127. end
  128.  
  129.  
  130. "find(s1,s2,i1,i2) - generates the sequence of positions in s2 at which "
  131. "s1 occurs as a substring in s2[i1:i2], but fails if there is no such position."
  132.  
  133. function{*} find(s1,s2,i,j)
  134.    str_anal( s2, i, j )
  135.    if !cnv:string(s1) then
  136.       runerr(103,s1)
  137.  
  138.    body {
  139.       register char *str1, *str2;
  140.       C_integer s1_len, l, term;
  141.  
  142.       /*
  143.        * Loop through s2[i:j] trying to find s1 at each point, stopping
  144.        * when the remaining portion s2[i:j] is too short to contain s1.
  145.        * Optimize me!
  146.        */
  147.       s1_len = StrLen(s1);
  148.       term = cnv_j - s1_len;
  149.       while (cnv_i <= term) {
  150.          str1 = StrLoc(s1);
  151.          str2 = StrLoc(s2) + cnv_i - 1;
  152.          l    = s1_len;
  153.  
  154.          /*
  155.           * Compare strings on a byte-wise basis; if the end is reached
  156.           * before inequality is found, suspend with the position of the
  157.           * string.
  158.           */
  159.          do {
  160.             if (l-- <= 0) {
  161.                suspend C_integer cnv_i;
  162.                break;
  163.                }
  164.             } while (*str1++ == *str2++);
  165.          cnv_i++;
  166.          }
  167.       fail;
  168.       }
  169. end
  170.  
  171.  
  172. "many(c,s,i1,i2) - produces the position in s after the longest initial "
  173. "sequence of characters in c in s[i1:i2] but fails if there is none."
  174.  
  175. function{0,1} many(c,s,i,j)
  176.    str_anal( s, i, j )
  177.    if !cnv:tmp_cset(c) then
  178.       runerr(104,c)
  179.    body {
  180.       C_integer start_i = cnv_i;
  181.       /*
  182.        * Move i along s[i:j] until a character that is not in c is found
  183.        *  or the end of the string is reached.
  184.        */
  185.       while (cnv_i < cnv_j) {
  186.          if (!Testb(StrLoc(s)[cnv_i-1], c))
  187.             break;
  188.          cnv_i++;
  189.          }
  190.       /*
  191.        * Fail if no characters in c were found; otherwise
  192.        *  return the position of the first character not in c.
  193.        */
  194.       if (cnv_i == start_i)
  195.          fail;
  196.       return C_integer cnv_i;
  197.       }
  198. end
  199.  
  200.  
  201. "match(s1,s2,i1,i2) - produces i1+*s1 if s1==s2[i1+:*s1], but fails otherwise."
  202.  
  203. function{0,1} match(s1,s2,i,j)
  204.    str_anal( s2, i, j )
  205.    if !cnv:tmp_string(s1) then
  206.       runerr(103,s1)
  207.    body {
  208.       char *str1, *str2;
  209.  
  210.       /*
  211.        * Cannot match unless s2[i:j] is as long as s1.
  212.        */
  213.       if (cnv_j - cnv_i < StrLen(s1))
  214.          fail;
  215.  
  216.       /*
  217.        * Compare s1 with s2[i:j] for *s1 characters; fail if an
  218.        *  inequality is found.
  219.        */
  220.       str1 = StrLoc(s1);
  221.       str2 = StrLoc(s2) + cnv_i - 1;
  222.       for (cnv_j = StrLen(s1); cnv_j > 0; cnv_j--)
  223.          if (*str1++ != *str2++)
  224.             fail;
  225.  
  226.       /*
  227.        * Return position of end of matched string in s2.
  228.        */
  229.       return C_integer cnv_i + StrLen(s1);
  230.       }
  231. end
  232.  
  233.  
  234. "upto(c,s,i1,i2) - generates the sequence of integer positions in s up to a "
  235. "character in c in s[i2:i2], but fails if there is no such position."
  236.  
  237. function{*} upto(c,s,i,j)
  238.    str_anal( s, i, j )
  239.    if !cnv:tmp_cset(c) then
  240.       runerr(104,c)
  241.    body {
  242.       C_integer tmp;
  243.  
  244.       /*
  245.        * Look through s[i:j] and suspend position of each occurrence of
  246.        * of a character in c.
  247.        */
  248.       while (cnv_i < cnv_j) {
  249.          tmp = (C_integer)StrLoc(s)[cnv_i-1];
  250.          if (Testb(tmp, c)) {
  251.             suspend C_integer cnv_i;
  252.             }
  253.          cnv_i++;
  254.          }
  255.       /*
  256.        * Eventually fail.
  257.        */
  258.       fail;
  259.       }
  260. end
  261.