home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / OL.LZH / PROCS.LZH / FINDRE.ICN < prev    next >
Text File  |  1991-09-05  |  21KB  |  707 lines
  1. ########################################################################
  2. #    
  3. #    Name:    findre.icn
  4. #    
  5. #    Title:    "Find" Regular Expression
  6. #    
  7. #    Author:    Richard L. Goerwitz
  8. #
  9. #    Version: 1.14
  10. #
  11. #    Date:     June 1, 1991
  12. #
  13. ########################################################################
  14. #
  15. #    findre() is like the Icon builtin function find(),
  16. #  except that it takes, as its first argument, a regular expression
  17. #  pretty much like the ones the Unix egrep command uses (the few
  18. #  minor differences are listed below).  Its syntax is the same as
  19. #  find's (i.e. findre(s1,s2,i,j)), with the exception that a no-
  20. #  argument invocation wipes out all static structures utilized by
  21. #  findre, and then forces a garbage collection.
  22. #
  23. #  (For those not familiar with regular expressions and the Unix egrep
  24. #  command: findre() offers a simple and compact wildcard-based search
  25. #  system.  If you do a lot of searches through text files, or write
  26. #  programs which do searches based on user input, then findre is a
  27. #  utility you might want to look over.)
  28. #
  29. #  Important differences between find and findre:  As noted above,
  30. #  findre() is just a find() function that takes a regular expression
  31. #  as its first argument.  One major problem with this setup is that
  32. #  it leaves the user with no easy way to tab past a matched
  33. #  substring, as with
  34. # 
  35. #    s ? write(tab(find("hello")+5))
  36. #
  37. #  In order to remedy this intrinsic deficiency, findre() sets the
  38. #  global variable __endpoint to the first position after any given
  39. #  match occurs.  Use this variable with great care, preferably
  40. #  assigning its value to some other variable immediately after the
  41. #  match (for example, findre("hello [.?!]*",s) & tmp := __endpoint).
  42. #  Otherwise, you will certainly run into trouble.  (See the example
  43. #  below for an illustration of how __endpoint is used).
  44. #
  45. #  Important differences between egrep and findre:  findre utilizes
  46. #  the same basic language as egrep.  The only big difference is that
  47. #  findre uses intrinsic Icon data structures and escaping conven-
  48. #  tions rather than those of any particular Unix variant.  Be care-
  49. #  ful!  If you put findre("\(hello\)",s) into your source file,
  50. #  findre will treat it just like findre("(hello)",s).  If, however,
  51. #  you enter '\(hello\)' at run-time (via, say, findre(!&input,s)),
  52. #  what Icon receives will depend on your operating system (most
  53. #  likely, a trace will show "\\(hello\\)").
  54. #
  55. #  Bugs:  Space has essentially been conserved at the expense of time
  56. #  in the automata produced by findre().  The algorithm, in other
  57. #  words, will produce the equivalent of a pushdown automaton under
  58. #  certain circumstances, rather than strive (at the expense of space)
  59. #  for full determinism.  I tried to make up a nfa -> dfa converter
  60. #  that would only create that portion of the dfa it needed to accept
  61. #  or reject a string, but the resulting automaton was actually quite
  62. #  slow (if anyone can think of a way to do this in Icon, and keep it
  63. #  small and fast, please let us all know about it).  Note that under
  64. #  version 8 of Icon, findre takes up negligible storage space, due to
  65. #  the much improved hashing algorithm.  I have not tested it under
  66. #  version 7, but I would expect it to use up quite a bit more space
  67. #  in that environment.
  68. #
  69. #  Important note:  findre takes a shortest-possible-match approach
  70. #  to regular expressions.  In other words, if you look for "a*",
  71. #  findre will not even bother looking for an "a."  It will just match
  72. #  the empty string.  Without this feature, findre would perform a bit
  73. #  more slowly.  The problem with such an approach is that often the
  74. #  user will want to tab past the longest possible string of matched
  75. #  characters (say tab((findre("a*|b*"), __endpoint)).  In circumstan-
  76. #  ces like this, please just use something like:
  77. #
  78. #      s ? {
  79. #          tab(find("a")) &  # or use Arb() from the IPL (patterns.icn)
  80. #          tab(many('a'))
  81. #          tab(many('b'))
  82. #      }
  83. #
  84. #  or else use some combination of findre and the above.
  85. #    
  86. ########################################################################
  87. #
  88. #  Regular expression syntax: Regular expression syntax is complex,
  89. #  and yet simple.  It is simple in the sense that most of its power
  90. #  is concentrated in about a dozen easy-to-learn symbols.  It is
  91. #  complex in the sense that, by combining these symbols with
  92. #  characters, you can represent very intricate patterns.
  93. #
  94. #  I make no pretense here of offering a full explanation of regular
  95. #  expressions, their usage, and the deeper nuances of their syntax.
  96. #  As noted above, this should be gleaned from a Unix manual.  For
  97. #  quick reference, however, I have included a brief summary of all
  98. #  the special symbols used, accompanied by an explanation of what
  99. #  they mean, and, in some cases, of how they are used (most of this
  100. #  is taken from the comments prepended to Jerry Nowlin's Icon-grep
  101. #  command, as posted a couple of years ago):
  102. #
  103. #     ^   -  matches if the following pattern is at the beginning
  104. #            of a line (i.e. ^# matches lines beginning with "#")
  105. #     $   -  matches if the preceding pattern is at the end of a line
  106. #     .   -  matches any single character
  107. #     +   -  matches from 1 to any number of occurrences of the
  108. #            previous expression (i.e. a character, or set of paren-
  109. #            thesized/bracketed characters)
  110. #     *   -  matches from 0 to any number of occurrences of the previous
  111. #            expression
  112. #     \   -  removes the special meaning of any special characters
  113. #            recognized by this program (i.e if you want to match lines
  114. #            beginning with a "[", write ^\[, and not ^[)
  115. #     |   -  matches either the pattern before it, or the one after
  116. #            it (i.e. abc|cde matches either abc or cde)
  117. #     []  -  matches any member of the enclosed character set, or,
  118. #            if ^ is the first character, any nonmember of the
  119. #            enclosed character set (i.e. [^ab] matches any character
  120. #         _except_ a and b).
  121. #     ()  -  used for grouping (e.g. ^(abc|cde)$ matches lines consist-
  122. #            ing of either "abc" or "cde," while ^abc|cde$ matches
  123. #            lines either beginning with "abc" or ending in "cde")
  124. #
  125. #########################################################################
  126. #
  127. #  Example program:
  128. #
  129. #  procedure main(a)
  130. #      while line := !&input do {
  131. #          token_list := tokenize_line(line,a[1])
  132. #          every write(!token_list)
  133. #      }
  134. #  end
  135. #
  136. #  procedure tokenize_line(s,sep)
  137. #      tmp_lst := []
  138. #      s ? {
  139. #          while field := tab(findre(sep)|0) &
  140. #          mark := __endpoint
  141. #          do {
  142. #              put(tmp_lst,"" ~== field)
  143. #              if pos(0) then break
  144. #              else tab(mark)
  145. #          }
  146. #      }
  147. #      return tmp_lst
  148. #  end
  149. #
  150. #  The above program would be compiled with findre (e.g. "icont
  151. #  test_prg.icn findre.icn") to produce a single executable which
  152. #  tokenizes each line of input based on a user-specified delimiter.
  153. #  Note how __endpoint is set soon after findre() succeeds.  Note
  154. #  also how empty fields are excluded with "" ~==, etc.  Finally, note
  155. #  that the temporary list, tmp_lst, is not needed.  It is included
  156. #  here merely to illustrate one way in which tokens might be stored.
  157. #
  158. #  Tokenizing is, of course, only one of many uses one might put
  159. #  findre to.  It is very helpful in allowing the user to construct
  160. #  automata at run-time.  If, say, you want to write a program that
  161. #  searches text files for patterns given by the user, findre would be
  162. #  a perfect utility to use.  Findre in general permits more compact
  163. #  expression of patterns than one can obtain using intrinsic Icon
  164. #  scanning facilities.  Its near complete compatibility with the Unix
  165. #  regexp library, moreover, makes for greater ease of porting,
  166. #  especially in cases where Icon is being used to prototype C code.
  167. #
  168. #########################################################################
  169.  
  170. global state_table, parends_present, slash_present
  171. global biggest_nonmeta_str, __endpoint
  172. record o_a_s(op,arg,state)
  173.  
  174.  
  175. procedure findre(re, s, i, j)
  176.  
  177.     local p, x, nonmeta_len
  178.     static FSTN_table, STRING_table
  179.     initial {
  180.     FSTN_table := table()
  181.     STRING_table := table()
  182.     }
  183.  
  184.     if /re then {
  185.     FSTN_table := table()
  186.     STRING_table := table()
  187.     collect()  # do it *now*
  188.     return
  189.     }
  190.  
  191.     /s := &subject
  192.     if \i then {
  193.     if i < 1 then
  194.         i := *s + (i+1)
  195.     }
  196.     else i := \&pos | 1
  197.     if \j then {
  198.     if j < 1 then
  199.         j := *s + (j+1)
  200.     }
  201.  
  202.     else j := *s+1
  203.     if /FSTN_table[re] then {
  204.     # If we haven't seen this re before, then...
  205.     if \STRING_table[re] then {
  206.         # ...if it's in the STRING_table, use plain find()
  207.         every p := find(STRING_table[re],s,i,j)
  208.         do { __endpoint := p + *STRING_table[re]; suspend p }
  209.         fail
  210.     }
  211.     else {
  212.         # However, if it's not in the string table, we have to
  213.         # tokenize it and check for metacharacters.  If it has
  214.         # metas, we create an FSTN, and put that into FSTN_table;
  215.         # otherwise, we just put it into the STRING_table.
  216.         tokenized_re := tokenize(re)
  217.         if 0 > !tokenized_re then {
  218.         # if at least one element is < 0, re has metas
  219.         MakeFSTN(tokenized_re) | err_out(re,2)
  220.         # both biggest_nonmeta_str and state_table are global
  221.         /FSTN_table[re] := [.biggest_nonmeta_str, copy(state_table)]
  222.         }
  223.         else {
  224.         # re has no metas; put the input string into STRING_table
  225.         # for future reference, and execute find() at once
  226.         tmp := ""; every tmp ||:= char(!tokenized_re)
  227.         insert(STRING_table,re,tmp)
  228.         every p := find(STRING_table[re],s,i,j)
  229.         do { __endpoint := p + *STRING_table[re]; suspend p }
  230.         fail
  231.         }
  232.     }
  233.     }
  234.  
  235.  
  236.     if nonmeta_len := (1 < *FSTN_table[re][1]) then {
  237.     # If the biggest non-meta string in the original re
  238.     # was more than 1, then put in a check for it...
  239.     s[1:j] ? {
  240.         tab(x := i to j - nonmeta_len) &
  241.         (find(FSTN_table[re][1]) | fail) \ 1 &
  242.         (__endpoint := apply_FSTN(&null,FSTN_table[re][2])) &
  243.         (suspend x)
  244.     }
  245.     }
  246.     else {
  247.     #...otherwise it's not worth worrying about the biggest nonmeta str
  248.     s[1:j] ? {
  249.         tab(x := i to j) &
  250.         (__endpoint := apply_FSTN(&null,FSTN_table[re][2])) &
  251.         (suspend x)
  252.     }
  253.     }
  254.  
  255. end
  256.  
  257.  
  258.  
  259. procedure apply_FSTN(ini,tbl)
  260.  
  261.     static s_tbl
  262.     local POS, tmp, fin
  263.  
  264.     /ini := 1 & s_tbl := tbl & biggest_pos := 1
  265.     if ini = 0 then {
  266.     return &pos
  267.     }
  268.     POS := &pos
  269.     fin := 0
  270.  
  271.     repeat {
  272.     if tmp := !s_tbl[ini] &
  273.         tab(tmp.op(tmp.arg))
  274.     then {
  275.         if tmp.state = fin
  276.         then return &pos
  277.         else ini := tmp.state
  278.     }
  279.     else (&pos := POS, fail)
  280.     }
  281.  
  282. end
  283.     
  284.  
  285.  
  286. procedure tokenize(s)
  287.  
  288.     local chr, tmp
  289.  
  290.     token_list := list()
  291.     s ? {
  292.     tab(many('*+?|'))
  293.     while chr := move(1) do {
  294.         if chr == "\\"
  295.         # it can't be a metacharacter; remove the \ and "put"
  296.         # the integer value of the next chr into token_list
  297.         then put(token_list,ord(move(1))) | err_out(s,2,chr)
  298.         else if any('*+()|?.$^',chr)
  299.         then {
  300.         # Yuck!  Egrep compatibility stuff.
  301.         case chr of {
  302.             "*"    : {
  303.             tab(many('*+?'))
  304.             put(token_list,-ord("*"))
  305.             }
  306.             "+"    : {
  307.             tmp := tab(many('*?+')) | &null
  308.             if upto('*?',\tmp)
  309.             then put(token_list,-ord("*"))
  310.             else put(token_list,-ord("+"))
  311.             }
  312.             "?"    : {
  313.             tmp := tab(many('*?+')) | &null
  314.             if upto('*+',\tmp)
  315.             then put(token_list,-ord("*"))
  316.             else put(token_list,-ord("?"))
  317.             }
  318.             "("    : {
  319.             tab(many('*+?'))
  320.             put(token_list,-ord("("))
  321.             }
  322.             default: {
  323.             put(token_list,-ord(chr))
  324.             }
  325.         }
  326.         }
  327.         else {
  328.         case chr of {
  329.             # More egrep compatibility stuff.
  330.             "["    : {
  331.             b_loc := find("[") | *&subject+1
  332.             every next_one := find("]",,,b_loc)
  333.             \next_one ~= &pos | err_out(s,2,chr)
  334.             put(token_list,-ord(chr))
  335.             }
  336.                     "]"    : {
  337.             if &pos = (\next_one+1)
  338.             then put(token_list,-ord(chr)) &
  339.                  next_one := &null
  340.             else put(token_list,ord(chr))
  341.             }
  342.             default: put(token_list,ord(chr))
  343.         }
  344.         }
  345.     }
  346.     }
  347.  
  348.     token_list := UnMetaBrackets(token_list)
  349.  
  350.     fixed_length_token_list := list(*token_list)
  351.     every i := 1 to *token_list
  352.     do fixed_length_token_list[i] := token_list[i]
  353.     return fixed_length_token_list
  354.  
  355. end
  356.  
  357.  
  358.  
  359. procedure UnMetaBrackets(l)
  360.  
  361.     # Since brackets delineate a cset, it doesn't make
  362.     # any sense to have metacharacters inside of them.
  363.     # UnMetaBrackets makes sure there are no metacharac-
  364.     # ters inside of the braces.
  365.  
  366.     local tmplst, i, Lb, Rb
  367.  
  368.     tmplst := list(); i := 0
  369.     Lb := -ord("[")
  370.     Rb := -ord("]")
  371.  
  372.     while (i +:= 1) <= *l do {
  373.     if l[i] = Lb then {
  374.         put(tmplst,l[i])
  375.         until l[i +:= 1] = Rb
  376.         do put(tmplst,abs(l[i]))
  377.         put(tmplst,l[i])
  378.     }
  379.     else put(tmplst,l[i])
  380.     }
  381.     return tmplst
  382.  
  383. end
  384.  
  385.  
  386.  
  387. procedure MakeFSTN(l,INI,FIN)
  388.  
  389.     # MakeFSTN recursively descends through the tree structure
  390.     # implied by the tokenized string, l, recording in (global)
  391.     # fstn_table a list of operations to be performed, and the
  392.     # initial and final states which apply to them.
  393.  
  394.     # global biggest_nonmeta_str, slash_present, parends_present
  395.     static Lp, Rp, Sl, Lb, Rb, Caret_inside, Dot, Dollar, Caret_outside
  396.     local i, inter, inter2, tmp
  397.     initial {
  398.     Lp := -ord("("); Rp := -ord(")")
  399.     Sl := -ord("|")
  400.     Lb := -ord("["); Rb := -ord("]"); Caret_inside := ord("^")
  401.     Dot := -ord("."); Dollar := -ord("$"); Caret_outside := -ord("^")
  402.     }
  403.  
  404.     /INI := 1 & state_table := table() &
  405.     NextState("new") & biggest_nonmeta_str := ""
  406.     /FIN := 0
  407.  
  408.     # I haven't bothered to test for empty lists everywhere.
  409.     if *l = 0 then {
  410.     /state_table[INI] := []
  411.     put(state_table[INI],o_a_s(zSucceed,&null,FIN))
  412.     return
  413.     }
  414.  
  415.     # HUNT DOWN THE SLASH (ALTERNATION OPERATOR)
  416.     every i := 1 to *l do {
  417.     if l[i] = Sl & tab_bal(l,Lp,Rp) = i then {
  418.         if i = 1 then err_out(l,2,char(abs(l[i]))) else {
  419.         /slash_present := "yes"
  420.         inter := NextState()
  421.         inter2:= NextState()
  422.         MakeFSTN(l[1:i],inter2,FIN)
  423.         MakeFSTN(l[i+1:0],inter,FIN)
  424.         /state_table[INI] := []
  425.         put(state_table[INI],o_a_s(apply_FSTN,inter2,0))
  426.         put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  427.         return
  428.         }
  429.     }
  430.     }
  431.  
  432.     # HUNT DOWN PARENTHESES
  433.     if l[1] = Lp then {
  434.     i := tab_bal(l,Lp,Rp) | err_out(l,2,"(")
  435.     inter := NextState()
  436.     if any('*+?',char(abs(0 > l[i+1]))) then {
  437.         case l[i+1] of {
  438.         -ord("*")   : {
  439.             /state_table[INI] := []
  440.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  441.             MakeFSTN(l[2:i],INI,INI)
  442.             MakeFSTN(l[i+2:0],inter,FIN)
  443.             return
  444.         }
  445.         -ord("+")   : {
  446.             inter2 := NextState()
  447.             /state_table[inter2] := []
  448.             MakeFSTN(l[2:i],INI,inter2)
  449.             put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
  450.             MakeFSTN(l[2:i],inter2,inter2)
  451.             MakeFSTN(l[i+2:0],inter,FIN)
  452.             return
  453.         }
  454.         -ord("?")   : {
  455.             /state_table[INI] := []
  456.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  457.             MakeFSTN(l[2:i],INI,inter)
  458.             MakeFSTN(l[i+2:0],inter,FIN)
  459.             return
  460.         }
  461.         }
  462.     }
  463.     else {
  464.         MakeFSTN(l[2:i],INI,inter)
  465.         MakeFSTN(l[i+1:0],inter,FIN)
  466.         return
  467.     }
  468.     }
  469.     else {     # I.E. l[1] NOT = Lp (left parenthesis as -ord("("))
  470.     every i := 1 to *l do {
  471.         case l[i] of {
  472.         Lp     : {
  473.             inter := NextState()
  474.             MakeFSTN(l[1:i],INI,inter)
  475.             /parends_present := "yes"
  476.             MakeFSTN(l[i:0],inter,FIN)
  477.             return
  478.         }
  479.         Rp     : err_out(l,2,")")
  480.         }
  481.     }
  482.     }
  483.  
  484.     # NOW, HUNT DOWN BRACKETS
  485.     if l[1] = Lb then {
  486.     i := tab_bal(l,Lb,Rb) | err_out(l,2,"[")
  487.     inter := NextState()
  488.     tmp := ""; every tmp ||:= char(l[2 to i-1])
  489.     if Caret_inside = l[2]
  490.     then tmp := ~cset(Expand(tmp[2:0]))
  491.     else tmp :=  cset(Expand(tmp))
  492.     if any('*+?',char(abs(0 > l[i+1]))) then {
  493.         case l[i+1] of {
  494.         -ord("*")   : {
  495.             /state_table[INI] := []
  496.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  497.             put(state_table[INI],o_a_s(any,tmp,INI))
  498.             MakeFSTN(l[i+2:0],inter,FIN)
  499.             return
  500.         }
  501.         -ord("+")   : {
  502.             inter2 := NextState()
  503.             /state_table[INI] := []
  504.             put(state_table[INI],o_a_s(any,tmp,inter2))
  505.             /state_table[inter2] := []
  506.             put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
  507.             put(state_table[inter2],o_a_s(any,tmp,inter2))
  508.             MakeFSTN(l[i+2:0],inter,FIN)
  509.             return
  510.         }
  511.         -ord("?")   : {
  512.             /state_table[INI] := []
  513.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  514.             put(state_table[INI],o_a_s(any,tmp,inter))
  515.             MakeFSTN(l[i+2:0],inter,FIN)
  516.             return
  517.         }
  518.         }
  519.     }
  520.     else {
  521.         /state_table[INI] := []
  522.         put(state_table[INI],o_a_s(any,tmp,inter))
  523.         MakeFSTN(l[i+1:0],inter,FIN)
  524.         return
  525.     }
  526.     }
  527.     else {           # I.E. l[1] not = Lb
  528.     every i := 1 to *l do {
  529.         case l[i] of {
  530.         Lb     : {
  531.             inter := NextState()
  532.             MakeFSTN(l[1:i],INI,inter)
  533.             MakeFSTN(l[i:0],inter,FIN)
  534.             return
  535.         }
  536.         Rb     : err_out(l,2,"]")
  537.         }
  538.     }
  539.     }
  540.  
  541.     # FIND INITIAL SEQUENCES OF POSITIVE INTEGERS, CONCATENATE THEM
  542.     if i := match_positive_ints(l) then {
  543.     inter := NextState()
  544.     tmp := Ints2String(l[1:i])
  545.     # if a slash has been encountered already, forget optimizing
  546.         # in this way; if parends are present, too, then forget it,
  547.         # unless we are at the beginning or end of the input string
  548.     if  INI = 1 | FIN = 2 | /parends_present &
  549.         /slash_present & *tmp > *biggest_nonmeta_str
  550.     then biggest_nonmeta_str := tmp
  551.     /state_table[INI] := []
  552.     put(state_table[INI],o_a_s(match,tmp,inter))
  553.     MakeFSTN(l[i:0],inter,FIN)
  554.     return
  555.     }
  556.  
  557.     # OKAY, CLEAN UP ALL THE JUNK THAT'S LEFT
  558.     i := 0
  559.     while (i +:= 1) <= *l do {
  560.     case l[i] of {
  561.         Dot          : { Op := any;   Arg := &cset }
  562.         Dollar       : { Op := pos;   Arg := 0     }
  563.         Caret_outside: { Op := pos;   Arg := 1     }
  564.         default      : { Op := match; Arg := char(0 < l[i]) }
  565.     } | err_out(l,2,char(abs(l[i])))
  566.     inter := NextState()
  567.     if any('*+?',char(abs(0 > l[i+1]))) then {
  568.         case l[i+1] of {
  569.         -ord("*")   : {
  570.             /state_table[INI] := []
  571.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  572.             put(state_table[INI],o_a_s(Op,Arg,INI))
  573.             MakeFSTN(l[i+2:0],inter,FIN)
  574.             return
  575.         }
  576.         -ord("+")   : {
  577.             inter2 := NextState()
  578.             /state_table[INI] := []
  579.             put(state_table[INI],o_a_s(Op,Arg,inter2))
  580.             /state_table[inter2] := []
  581.             put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
  582.             put(state_table[inter2],o_a_s(Op,Arg,inter2))
  583.             MakeFSTN(l[i+2:0],inter,FIN)
  584.             return
  585.         }
  586.         -ord("?")   : {
  587.             /state_table[INI] := []
  588.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  589.             put(state_table[INI],o_a_s(Op,Arg,inter))
  590.             MakeFSTN(l[i+2:0],inter,FIN)
  591.             return
  592.         }
  593.         }
  594.     }
  595.     else {
  596.         /state_table[INI] := []
  597.         put(state_table[INI],o_a_s(Op,Arg,inter))
  598.         MakeFSTN(l[i+1:0],inter,FIN)
  599.         return
  600.     }
  601.     }
  602.  
  603.     # WE SHOULD NOW BE DONE INSERTING EVERYTHING INTO state_table
  604.     # IF WE GET TO HERE, WE'VE PARSED INCORRECTLY!
  605.     err_out(l,4)
  606.  
  607. end
  608.  
  609.  
  610.  
  611. procedure NextState(new)
  612.     static nextstate
  613.     if \new then nextstate := 1
  614.     else nextstate +:= 1
  615.     return nextstate
  616. end
  617.  
  618.  
  619.  
  620. procedure err_out(x,i,elem)
  621.     writes(&errout,"Error number ",i," parsing ",image(x)," at ")
  622.     if \elem 
  623.     then write(&errout,image(elem),".")
  624.     else write(&errout,"(?).")
  625.     exit(i)
  626. end
  627.  
  628.  
  629.  
  630. procedure zSucceed()
  631.     return .&pos
  632. end
  633.  
  634.  
  635.  
  636. procedure Expand(s)
  637.  
  638.     s2 := ""
  639.     s ? {
  640.     s2 ||:= ="^"
  641.     s2 ||:= ="-"
  642.     while s2 ||:= tab(find("-")-1) do {
  643.         if (c1 := move(1), ="-",
  644.         c2 := move(1),
  645.         c1 << c2)
  646.         then every s2 ||:= char(ord(c1) to ord(c2))
  647.         else s2 ||:= 1(move(2), not(pos(0))) | err_out(s,2,"-")
  648.     }
  649.     s2 ||:= tab(0)
  650.     }
  651.     return s2
  652.  
  653. end
  654.  
  655.  
  656.  
  657. procedure tab_bal(l,i1,i2)
  658.     i := 0
  659.     i1_count := 0; i2_count := 0
  660.     while (i +:= 1) <= *l do {
  661.     case l[i] of {
  662.         i1  : i1_count +:= 1
  663.         i2  : i2_count +:= 1
  664.     }
  665.     if i1_count = i2_count
  666.     then suspend i
  667.     }
  668. end
  669.  
  670.  
  671. procedure match_positive_ints(l)
  672.     
  673.     # Matches the longest sequence of positive integers in l,
  674.     # beginning at l[1], which neither contains, nor is fol-
  675.     # lowed by a negative integer.  Returns the first position
  676.     # after the match.  Hence, given [55, 55, 55, -42, 55],
  677.     # match_positive_ints will return 3.  [55, -42] will cause
  678.     # it to fail rather than return 1 (NOTE WELL!).
  679.  
  680.     every i := 1 to *l do {
  681.     if l[i] < 0
  682.     then return (3 < i) - 1 | fail
  683.     }
  684.     return *l + 1
  685.  
  686. end
  687.  
  688.  
  689. procedure Ints2String(l)
  690.     tmp := ""
  691.     every tmp ||:= char(!l)
  692.     return tmp
  693. end
  694.  
  695.  
  696. procedure StripChar(s,s2)
  697.     if find(s2,s) then {
  698.     tmp := ""
  699.     s ? {
  700.         while tmp ||:= tab(find("s2"))
  701.         do tab(many(cset(s2)))
  702.         tmp ||:= tab(0)
  703.     }
  704.     }
  705.     return \tmp | s
  706. end
  707.