home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / contrib / menu / regexp.icn < prev    next >
Text File  |  1992-05-18  |  26KB  |  784 lines
  1. ############################################################################
  2. #
  3. #       Name:   regexp.icn
  4. #
  5. #       Title:  UNIX-like Regular Expression Pattern Matching Procedures
  6. #
  7. #       Author: Robert J. Alexander
  8. #
  9. #       Date:   January 28, 1992
  10. #
  11. #    Thanks:    To Richard Goerwitz for very helpful feedback in
  12. #        debugging this code.
  13. #
  14. ############################################################################
  15. #
  16. #  This is a kit of procedures to deal with UNIX-like regular expression
  17. #  patterns.
  18. #
  19. #  These procedures are interesting partly because of the "recursive
  20. #  suspension" (or "suspensive recursion" :-) technique used to simulate
  21. #  conjunction of an arbitrary number of computed expressions (see
  22. #  notes, below).
  23. #
  24. #
  25. #  The public procedures are:
  26. #
  27. #  ReMatch(pattern,s,i1,i2) : i3,i4,...,iN
  28. #  ReFind(pattern,s,i1,i2) : i3,i4,...,iN
  29. #  RePat(s) : pattern list
  30. #
  31. #
  32. #  ReMatch() produces the sequence of positions in "s" past a substring
  33. #  starting at "i1" that matches "pattern", but fails if there is no
  34. #  such position.  Similar to match(), but is capable of generating
  35. #  multiple positions.
  36. #
  37. #  ReFind() produces the sequence of positions in "s" where substrings
  38. #  begin that match "pattern", but fails if there is no such position.
  39. #  Similar to find().  Each position is produced only once, even if
  40. #  several possible matches are possible at that position.
  41. #
  42. #  "pattern" can be either a string or a pattern list -- see RePat(),
  43. #  below.
  44. #
  45. #  Default values of s, i1, and i2 are handled as for Icon's built-in
  46. #  string scanning procedures such as match().
  47. #
  48. #
  49. #  RePat(s) : L
  50. #
  51. #  Creates a pattern element list from pattern string "s", but fails if
  52. #  the pattern string is not syntactically correct.  ReMatch() and
  53. #  ReFind() will automatically convert a pattern string to a pattern
  54. #  list, but it is faster to do the conversion explicitly if multiple
  55. #  operations are done using the same pattern.  An additional advantage
  56. #  to compiling the pattern separately is avoiding ambiguity of failure
  57. #  caused by an incorrect pattern and failure to match a correct pattern.
  58. #
  59. #
  60. #  Accessible Global Variables
  61. #
  62. #  After a match, the strings matched by parenthesized regular
  63. #  expressions are left in list "Re_ParenGroups", and can be accessed by
  64. #  subscripting in using the same number as the \N construct.
  65. #
  66. #  If it is desired that regular expression format be similar to UNIX
  67. #  filename generation patterns but still retain the power of full
  68. #  regular expressions, make the following assignments prior to
  69. #  compiling the pattern string:
  70. #
  71. #       Re_ArbString := "*"     # Defaults to ".*"
  72. #
  73. #  The sets of characters (csets) that define a word, digits, and white
  74. #  space can be modified.  The following assignments can be made before
  75. #  compiling the pattern string.  The character sets are captured when
  76. #  the pattern is compiled, so changing them after pattern compilation
  77. #  will not alter the behavior of matches unless the pattern string is
  78. #  recompiled.
  79. #
  80. #       Re_WordChars := 'whatever you like'
  81. #                       # Defaults to &letters ++ &digits ++ "_"
  82. #       Re_Digits := &digits ++ 'ABCDEFabcdef'
  83. #                       # Defaults to &digits
  84. #       Re_Space := 'whatever you like'
  85. #                       # Defaults to ' \t\v\n\r\f'
  86. #
  87. #  These globals are normally not initialized until the first call to
  88. #  RePat(), and then only if they are null.  They can be explicitly
  89. #  initialized to their defaults (if they are null) by calling
  90. #  Re_Default().
  91. #
  92. #
  93. #  Characters compiled into patterns can be passed through a
  94. #  user-supplied filter procedure, provided in global variable
  95. #  Re_Filter.  The filtering is done before the characters are bound
  96. #  into the pattern.  The filter proc is passed one argument, the string
  97. #  to filter, and it must return the filtered string as its result.  If
  98. #  the filter proc fails, the string will be used unfiltered.  The
  99. #  filter proc is called with an argument of either type string (for
  100. #  characters in the pattern) or cset (for character classes [...]).  A
  101. #  typical use for this facility is to implement case-independent
  102. #  matching.  All pattern characters can downshifted by assigning
  103. #
  104. #       Re_Filter := map
  105. #
  106. #  Filtering is done only as the pattern is compiled.  Filtering of
  107. #  strings to be matched must be explicitly done.  Therefore,
  108. #  case-independent matching will occur only if map() is applied to all
  109. #  strings to be matched.
  110. #
  111. #
  112. #  By default, individual pattern elements are matched in a "leftmost-
  113. #  longest-first" sequence, which is the order observed by perl, egrep,
  114. #  and most other regular expression matchers.  If the order of matching
  115. #  is not important a performance improvement might be seen if pattern
  116. #  elements are matched in "shortest-first" order.  The following global
  117. #  variable setting causes the matcher to operate in leftmost-shortest-
  118. #  first order.
  119. #
  120. #    Re_LeftmostShortest := 1
  121. #  
  122. #
  123. #  In the case of patterns containing alternation, ReFind() will
  124. #  generally not produce positions in increasing order, but will produce
  125. #  all positions from the first term of the alternation (in increasing
  126. #  order) followed by all positions from the second (in increasing
  127. #  order).  If it is necessary that the positions be generated in
  128. #  strictly increasing order, with no duplicates, assign any non-null
  129. #  value to Re_Ordered:
  130. #
  131. #       Re_Ordered := 1
  132. #
  133. #  If the Re_Ordered option is chosen, there is a *small* penalty in
  134. #  efficiency in some cases, and the co-expression facility is required
  135. #  in your Icon implementation.
  136. #  
  137. #
  138. #  Regular Expression Characters and Features Supported
  139. #
  140. #  The regular expression format supported by procedures in this file
  141. #  model very closely those supported by the UNIX "egrep" program, with
  142. #  modifications as described in the Perl programming language
  143. #  definition.  Following is a brief description of the special
  144. #  characters used in regular expressions.  In the description, the
  145. #  abbreviation RE means regular expression.
  146. #
  147. #  c            An ordinary character (not one of the special characters
  148. #               discussed below) is a one-character RE that matches that
  149. #               character.
  150. #
  151. #  \c           A backslash followed by any special character is a one-
  152. #               character RE that matches the special character itself.
  153. #
  154. #               Note that backslash escape sequences representing
  155. #               non-graphic characters are not supported directly
  156. #               by these procedures.  Of course, strings coded in an
  157. #               Icon program will have such escapes handled by the
  158. #               Icon translator.  If such escapes must be supported
  159. #               in strings read from the run-time environment (e.g.
  160. #               files), they will have to be converted by other means,
  161. #               such as the Icon Program Library procedure "escape()".
  162. #
  163. #  .            A period is a one-character RE that matches any
  164. #               character.
  165. #
  166. #  [string]     A non-empty string enclosed in square brackets is a one-
  167. #               character RE that matches any *one* character of that
  168. #               string.  If, the first character is "^" (circumflex),
  169. #               the RE matches any character not in the remaining
  170. #               characters of the string.  The "-" (minus), when between
  171. #               two other characters, may be used to indicate a range of
  172. #               consecutive ASCII characters (e.g. [0-9] is equivalent to
  173. #               [0123456789]).  Other special characters stand for
  174. #               themselves in a bracketed string.
  175. #
  176. #  *            Matches zero or more occurrences of the RE to its left.
  177. #
  178. #  +            Matches one or more occurrences of the RE to its left.
  179. #
  180. #  ?            Matches zero or one occurrences of the RE to its left.
  181. #
  182. #  {N}          Matches exactly N occurrences of the RE to its left.
  183. #
  184. #  {N,}         Matches at least N occurrences of the RE to its left.
  185. #
  186. #  {N,M}        Matches at least N occurrences but at most M occurrences
  187. #               of the RE to its left.
  188. #
  189. #  ^            A caret at the beginning of an entire RE constrains
  190. #               that RE to match an initial substring of the subject
  191. #               string.
  192. #
  193. #  $            A currency symbol at the end of an entire RE constrains
  194. #               that RE to match a final substring of the subject string.
  195. #
  196. #  |            Alternation: two REs separated by "|" match either a
  197. #               match for the first or a match for the second.
  198. #
  199. #  ()           A RE enclosed in parentheses matches a match for the
  200. #               regular expression (parenthesized groups are used
  201. #               for grouping, and for accessing the matched string
  202. #               subsequently in the match using the \N expression).
  203. #
  204. #  \N           Where N is a digit in the range 1-9, matches the same
  205. #               string of characters as was matched by a parenthesized
  206. #               RE to the left in the same RE.  The sub-expression
  207. #               specified is that beginning with the Nth occurrence
  208. #               of "(" counting from the left.  E.g., ^(.*)\1$ matches
  209. #               a string consisting of two consecutive occurrences of
  210. #               the same string.
  211. #
  212. #  Extensions beyond UNIX egrep
  213. #
  214. #  The following extensions to UNIX REs, as specified in the Perl
  215. #  programming language, are supported.
  216. #
  217. #  \w           Matches any alphanumeric (including "_").
  218. #  \W           Matches any non-alphanumeric.
  219. #
  220. #  \b           Matches only at a word-boundary (word defined as a string
  221. #               of alphanumerics as in \w).
  222. #  \B           Matches only non-word-boundaries.
  223. #
  224. #  \s           Matches any white-space character.
  225. #  \S           Matches any non-white-space character.
  226. #
  227. #  \d           Matches any digit [0-9].
  228. #  \D           Matches any non-digit.
  229. #
  230. #  \w, \W, \s, \S, \d, \D can be used within [string] REs.
  231. #
  232. #
  233. #  Notes on computed conjunction expressions by "suspensive recursion"
  234. #
  235. #  A conjunction expression of an arbitrary number of terms can be
  236. #  computed in a looping fashion by the following recursive technique:
  237. #
  238. #       procedure Conjunct(v)
  239. #          if <there is another term to be appended to the conjunction> then
  240. #             suspend Conjunct(<the next term expression>)
  241. #          else
  242. #             suspend v
  243. #       end
  244. #
  245. #  The argument "v" is needed for producing the value of the last term
  246. #  as the value of the conjunction expression, accurately modeling Icon
  247. #  conjunction.  If the value of the conjunction is not needed, the
  248. #  technique can be slightly simplified by eliminating "v":
  249. #
  250. #       procedure ConjunctAndProduceNull()
  251. #          if <there is another term to be appended to the conjunction> then
  252. #             suspend ConjunctAndProduceNull(<the next term expression>)
  253. #          else
  254. #             suspend
  255. #       end
  256. #
  257. #  Note that <the next term expression> must still remain in the suspend
  258. #  expression to test for failure of the term, although its value is not
  259. #  passed to the recursive invocation.  This could have been coded as
  260. #
  261. #             suspend <the next term expression> & ConjunctAndProduceNull()
  262. #
  263. #  but wouldn't have been as provocative.
  264. #
  265. #  Since the computed conjunctions in this program are evaluated only for
  266. #  their side effects, the second technique is used in two situations:
  267. #
  268. #       (1)     To compute the conjunction of all of the elements in the
  269. #               regular expression pattern list (Re_match1()).
  270. #
  271. #       (2)     To evaluate the "exactly N times" and "N to M times"
  272. #               control operations (Re_NTimes()).
  273. #
  274.  
  275.  
  276. record Re_Tok(proc,args)
  277.  
  278. global Re_ParenGroups,Re_Filter,Re_Ordered
  279. global Re_WordChars,Re_NonWordChars
  280. global Re_Space,Re_NonSpace
  281. global Re_Digits,Re_NonDigits
  282. global Re_ArbString,Re_AnyString
  283. global Re_TabMatch
  284.  
  285.  
  286. ###################  Pattern Translation Procedures  ###################
  287.  
  288.  
  289. procedure RePat(s) # L
  290. #
  291. #  Produce pattern list representing pattern string s.
  292. #
  293.    #
  294.    #  Create a list of pattern elements.  Pattern strings are parsed
  295.    #  and converted into list elements as shown in the following table.
  296.    #  Since some list elements reference other pattern lists, the
  297.    #  structure is really a tree.
  298.    #
  299.    # Token      Generates                       Matches...
  300.    # -----      ---------                       ----------
  301.    #  ^         Re_Tok(pos,[1])                 Start of string or line
  302.    #  $         Re_Tok(pos,[0])                 End of string or line
  303.    #  .         Re_Tok(move,[1])                Any single character
  304.    #  +         Re_Tok(Re_OneOrMore,[tok])      At least one occurrence of
  305.    #                                            previous token
  306.    #  *         Re_Tok(Re_ArbNo,[tok])          Zero or more occurrences of
  307.    #                                            previous token
  308.    #  |         Re_Tok(Re_Alt,[pattern,pattern]) Either of prior expression
  309.    #                                            or next expression
  310.    #  [...]     Re_Tok(Re_TabAny,[cset])        Any single character in
  311.    #                                            specified set (see below)
  312.    #  (...)     Re_Tok(Re_MatchReg,[pattern])   Parenthesized pattern as
  313.    #                                            single token
  314.    #  <string of non-special characters>        The string of no-special
  315.    #            Re_Tok(Re+TabMatch,string)        characters
  316.    #  \b        Re_Tok(Re_WordBoundary,[Re_WordChars,Re_NonWordChars])
  317.    #                                            A word-boundary
  318.    #                                              (word default: [A-Za-z0-9_]+)
  319.    #  \B        Re_Tok(Re_NonWordBoundary,[Re_WordChars,Re_NonWordChars])
  320.    #                                            A non-word-boundary
  321.    #  \w        Re_Tok(Re_TabAny,[Re_WordChars])A word-character
  322.    #  \W        Re_Tok(Re_TabAny,[Re_NonWordChars]) A non-word-character
  323.    #  \s        Re_Tok(Re_TabAny,[Re_Space])    A space-character
  324.    #  \S        Re_Tok(Re_TabAny,[Re_NonSpace]) A non-space-character
  325.    #  \d        Re_Tok(Re_TabAny,[Re_Digits])   A digit
  326.    #  \D        Re_Tok(Re_TabAny,[Re_NonDigits]) A non-digit
  327.    #  {n,m}     Re_Tok(Re_NToMTimes,[tok,n,m])  n to m occurrences of
  328.    #                                            previous token
  329.    #  {n,}      Re_Tok(Re_NOrMoreTimes,[tok,n]) n or more occurrences of
  330.    #                                            previous token
  331.    #  {n}       Re_Tok(Re_NTimes,[tok,n])       exactly n occurrences of
  332.    #                                            previous token
  333.    #  ?         Re_Tok(Re_ZeroOrOneTimes,[tok]) one or zero occurrences of
  334.    #                                            previous token
  335.    #  \<digit>  Re_Tok(Re_MatchParenGroup,[n])  The string matched by
  336.    #                                            parenthesis group <digit>
  337.    #
  338.    local plist
  339.    static lastString,lastPList
  340.    #
  341.    #  Initialize.
  342.    #
  343.    initial {
  344.       Re_Default()
  345.       lastString := ""
  346.       lastPList := []
  347.       }
  348.  
  349.    if s === lastString then return lastPList
  350.  
  351.    Re_WordChars := cset(Re_WordChars)
  352.    Re_NonWordChars := ~Re_WordChars
  353.    Re_Space := cset(Re_Space)
  354.    Re_NonSpace := ~Re_Space
  355.    Re_Digits := cset(Re_Digits)
  356.    Re_NonDigits := ~Re_Digits
  357.  
  358.  
  359.    s ? (plist := Re_pat1(0)) | fail
  360.    lastString := s
  361.    lastPList := plist
  362.    return plist
  363. end
  364.  
  365.  
  366. procedure Re_pat1(level) # L
  367. #
  368. #  Recursive portion of RePat()
  369. #
  370.    local plist,n,m,c,comma
  371.    static parenNbr
  372.    initial {
  373.       Re_TabMatch := proc("=",1)
  374.       }
  375.    if level = 0 then parenNbr := 0
  376.    plist := []
  377.    #
  378.    #  Loop to put pattern elements on list.
  379.    #
  380.    until pos(0) do {
  381.       (="|",plist := [Re_Tok(Re_Alt,[plist,Re_pat1(level + 1) | fail])]) |
  382.       put(plist,
  383.          (="^",pos(2) | &subject[-2] == ("|" | "("),Re_Tok(pos,[1])) |
  384.          (="$",pos(0) | match("|" | ")"),Re_Tok(pos,[0])) |
  385.          (match(")"),level > 0,break) |
  386.          (=Re_ArbString,Re_Tok(Re_Arb)) |
  387.          (=Re_AnyString,Re_Tok(move,[1])) |
  388.          (="+",Re_Tok(Re_OneOrMore,[Re_prevTok(plist) | fail])) |
  389.          (="*",Re_Tok(Re_ArbNo,[Re_prevTok(plist) | fail])) |
  390.          1(Re_Tok(Re_TabAny,[c := Re_cset()]),\c | fail) |
  391.          3(="(",n := parenNbr +:= 1,
  392.                Re_Tok(Re_MatchReg,[Re_pat1(level + 1) | fail,n]),
  393.                move(1) | fail) |
  394.          (="\\b",Re_Tok(Re_WordBoundary,[Re_WordChars,Re_NonWordChars])) |
  395.          (="\\B",Re_Tok(Re_NonWordBoundary,[Re_WordChars,Re_NonWordChars])) |
  396.          (="\\w",Re_Tok(Re_TabAny,[Re_WordChars])) |
  397.          (="\\W",Re_Tok(Re_TabAny,[Re_NonWordChars])) |
  398.          (="\\s",Re_Tok(Re_TabAny,[Re_Space])) |
  399.          (="\\S",Re_Tok(Re_TabAny,[Re_NonSpace])) |
  400.          (="\\d",Re_Tok(Re_TabAny,[Re_Digits])) |
  401.          (="\\D",Re_Tok(Re_TabAny,[Re_NonDigits])) |
  402.          (="{",(n := tab(many(&digits)),comma := =(",") | &null,
  403.             m := tab(many(&digits)) | &null,="}") | fail,
  404.             if \m then Re_Tok(Re_NToMTimes,
  405.                   [Re_prevTok(plist),integer(n),integer(m)])
  406.             else if \comma then Re_Tok(Re_NOrMoreTimes,
  407.                   [Re_prevTok(plist),integer(n)])
  408.             else Re_Tok(Re_NTimes,[Re_prevTok(plist),integer(n)])) |
  409.          (="?",Re_Tok(Re_ZeroOrOneTimes,[Re_prevTok(plist) | fail])) |
  410.          Re_Tok(Re_TabMatch,[Re_string(level)]) |
  411.          (="\\",n := tab(any(&digits)),Re_Tok(Re_MatchParenGroup,[integer(n)]))
  412.          ) |
  413.       fail
  414.       }
  415.    return plist
  416. end
  417.  
  418.  
  419. procedure Re_prevTok(plist)
  420. #
  421. #  Pull previous token from the pattern list.  This procedure must take
  422. #  into account the fact that successive character tokens have been
  423. #  optimized into a single string token.
  424. #
  425.    local lastTok,s,r
  426.    lastTok := pull(plist) | fail
  427.    if lastTok.proc === Re_TabMatch then {
  428.       s := lastTok.args[1]
  429.       r := Re_Tok(Re_TabMatch,[s[-1]])
  430.       s[-1] := ""
  431.       if *s > 0 then {
  432.          put(plist,lastTok)
  433.          lastTok.args[1] := s
  434.          }
  435.       return r
  436.       }
  437.    return lastTok
  438. end
  439.  
  440.  
  441. procedure Re_Default()
  442. #
  443. #  Assign default values to regular expression translation globals, but
  444. #  only to variables whose values are null.
  445. #
  446.    /Re_WordChars := &letters ++ &digits ++ "_"
  447.    /Re_Space := ' \t\v\n\r\f'
  448.    /Re_Digits := &digits
  449.    /Re_ArbString := ".*"
  450.    /Re_AnyString := "."
  451.    return
  452. end
  453.  
  454.  
  455. procedure Re_cset()
  456. #
  457. #  Matches a [...] construct and returns a cset.
  458. #
  459.    local complement,c,e,ch,chars
  460.    ="[" | fail
  461.    (complement := ="^" | &null,c := move(1) || tab(find("]")),move(1)) |
  462.          return &null
  463.    c ? {
  464.       e := (="-" | "")
  465.       while chars := tab(upto('-\\')) do {
  466.          e ++:= case move(1) of {
  467.             "-": chars[1:-1] ++
  468.                   &cset[ord(chars[-1]) + 1:ord(move(1)) + 2] | return &null
  469.             "\\": case ch := move(1) of {
  470.                "w": Re_WordChars
  471.                "W": Re_NonWordChars
  472.                "s": Re_Space
  473.                "S": Re_NonSpace
  474.                "d": Re_Digits
  475.                "D": Re_NonDigits
  476.                default: ch
  477.                }
  478.             }
  479.          }
  480.       e ++:= tab(0)
  481.       if \complement then e := ~e
  482.       }
  483.    e := (\Re_Filter)(e)
  484.    return cset(e)
  485. end
  486.  
  487.  
  488. procedure Re_string(level)
  489. #
  490. #  Matches a string of non-special characters, returning a string.
  491. #
  492.    local special,s,p
  493.    static nondigits
  494.    initial nondigits := ~&digits
  495.    special := if level = 0 then '\\.+*|[({?' else  '\\.+*|[({?)'
  496.    s := tab(upto(special) | 0)
  497.    while ="\\" do {
  498.       p := &pos
  499.       if tab(any('wWbBsSdD')) |
  500.             (tab(any('123456789')) & (pos(0) | any(nondigits))) then {
  501.          tab(p - 1)
  502.          break
  503.          }
  504.       s ||:= move(1) || tab(upto(special) | 0)
  505.       }
  506.    if pos(0) & s[-1] == "$" then {
  507.       move(-1)
  508.       s[-1] := ""
  509.       }
  510.    s := string((\Re_Filter)(s))
  511.    return "" ~== s
  512. end
  513.  
  514.  
  515. #####################  Matching Engine Procedures  ########################
  516.  
  517.  
  518. procedure ReMatch(plist,s,i1,i2) # i3,i4,...,iN
  519. #
  520. #  Produce the sequence of positions in s past a string starting at i1
  521. #  that matches the pattern plist, but fails if there is no such
  522. #  position.  Similar to match(), but is capable of generating multiple
  523. #  positions.
  524. #
  525.    local i
  526.    if type(plist) ~== "list" then plist := RePat(plist) | fail
  527.    if /s := &subject then /i1 := &pos else /i1 := 1 ; /i2 := 0
  528.    i := match("",s,i1,i2) - 1 | fail
  529.    Re_ParenGroups := []
  530.    suspend s[i1:i2] ? (Re_match1(plist,1),i + &pos)
  531. end
  532.  
  533.  
  534. procedure Re_match1(plist,i) # s1,s2,...,sN
  535. #
  536. #  Used privately by ReMatch() to simulate a computed conjunction
  537. #  expression via recursive generation.
  538. #
  539.    local tok
  540.    suspend if tok := plist[i] then
  541.       Re_tok_match(tok,plist,i) & Re_match1(plist,i + 1) else &null
  542. end
  543.  
  544.  
  545. procedure ReFind(plist,s,i1,i2) # i3,i4,...,iN
  546. #
  547. #  Produce the sequence of positions in s where strings begin that match
  548. #  the pattern plist, but fails if there is no such position.  Similar
  549. #  to find().
  550. #
  551.    local i,p
  552.    if type(plist) ~== "list" then plist := RePat(plist) | fail
  553.    if /s := &subject then /i1 := &pos else /i1 := 1 ; /i2 := 0
  554.    i := match("",s,i1,i2) - 1 | fail
  555.    Re_ParenGroups := []
  556.    s[i1:i2] ? suspend (
  557.          tab(Re_skip(plist)) &
  558.          p := &pos &
  559.          Re_match1(plist,1)\1 &
  560.          i + p)
  561. end
  562.  
  563.  
  564. procedure Re_tok_match(tok,plist,i)
  565. #
  566. #  Match a single token.  Can be recursively called by the token
  567. #  procedure.
  568. #
  569.    local prc,results
  570.    prc := tok.proc
  571.    if \Re_LeftmostShortest then
  572.          suspend if prc === Re_Arb then Re_Arb(plist,i) else prc!tok.args
  573.    else {
  574.       results := []
  575.       every (if prc === Re_Arb then Re_Arb(plist,i) else prc!tok.args) do
  576.       push(results,&pos)
  577.       suspend tab(!results)
  578.       }
  579. end
  580.  
  581.  
  582. ##########  Heuristic Code for Matching Arbitrary Characters  ##########
  583.  
  584.  
  585. procedure Re_skip(plist,i) # s1,s2,...,sN
  586. #
  587. #  Used privately -- match a sequence of strings in s past which a match
  588. #  of the first pattern element in plist is likely to succeed.  This
  589. #  procedure is used for heuristic performance improvement by ReMatch()
  590. #  for the ".*" pattern element, and by ReFind().
  591. #
  592.    local x,s,p,prc,args
  593.    /i := 1
  594.    x := if type(plist) == "list" then plist[i] else plist
  595.    if /x then suspend find("")
  596.    else {
  597.       args := x.args
  598.       suspend case prc := x.proc of {
  599.      Re_TabMatch: find!args
  600.      Re_TabAny: upto!args
  601.      pos: args[1]
  602.      Re_WordBoundary |
  603.      Re_NonWordBoundary:
  604.            p := &pos & tab(Re_skip(plist,i + 1)) & prc!args & untab(p)
  605.      Re_MatchParenGroup: if s := \(\Re_ParenGroups)[args[1]] then
  606.            find(s) else find("")
  607.      Re_NToMTimes |
  608.      Re_NOrMoreTimes |
  609.      Re_NTimes:
  610.            if args[2] > 0 then Re_skip(args[1]) else find("")
  611.      Re_OneOrMore |
  612.      Re_MatchReg: Re_skip(args[1])
  613.      Re_Alt:
  614.            if \Re_Ordered then
  615.              Re_result_merge{Re_skip(args[1]),Re_skip(args[2])}
  616.            else
  617.              Re_skip(args[1 | 2])
  618.      default: find("")
  619.      }
  620.       }
  621. end
  622.  
  623.  
  624. procedure Re_result_merge(L)
  625. #
  626. #  Programmer-defined control operation to merge the result sequences of
  627. #  two integer-producing generators.  Both generators must produce their
  628. #  result sequences in numerically increasing order with no duplicates,
  629. #  and the output sequence will be in increasing order with no
  630. #  duplicates.
  631. #
  632.    local e1,e2,r1,r2
  633.    e1 := L[1] ; e2 := L[2]
  634.    r1 := @e1 ; r2 := @e2
  635.    while \(r1 | r2) do
  636.          if /r2 | \r1 < r2 then
  637.                suspend r1 do r1 := @e1 | &null
  638.          else if /r1 | r1 > r2 then
  639.                suspend r2 do r2 := @e2 | &null
  640.          else
  641.                r2 := @e2 | &null
  642. end
  643.  
  644.  
  645. procedure untab(origPos)
  646. #
  647. #  Converts a string scanning expression that moves the cursor to one
  648. #  that produces a cursor position and doesn't move the cursor (converts
  649. #  something like tab(find(x)) to find(x).  The template for using this
  650. #  procedure is
  651. #
  652. #       origPos := &pos ; tab(x) & ... & untab(origPos)
  653. #
  654.    local newPos
  655.    newPos := &pos
  656.    tab(origPos)
  657.    suspend newPos
  658.    tab(newPos)
  659. end
  660.  
  661.  
  662. #######################  Matching Procedures #######################
  663.  
  664.  
  665. procedure Re_Arb(plist,i)
  666. #
  667. #  Match arbitrary characters (.*)
  668. #
  669.    suspend tab(if plist[i + 1] then Re_skip(plist,i + 1) else find(""))
  670. end
  671.  
  672.  
  673. procedure Re_TabAny(C)
  674. #
  675. #  Match a character of a character set ([...],\w,\W,\s,\S,\d,\D)
  676. #
  677.    suspend tab(any(C))
  678. end
  679.  
  680.  
  681. procedure Re_MatchReg(tokList,groupNbr)
  682. #
  683. #  Match parenthesized group and assign matched string to list Re_ParenGroup
  684. #
  685.    local p,s
  686.    p := &pos
  687.    /Re_ParenGroups := []
  688.    every Re_match1(tokList,1) do {
  689.       while *Re_ParenGroups < groupNbr do put(Re_ParenGroups)
  690.       s := &subject[p:&pos]
  691.       Re_ParenGroups[groupNbr] := s
  692.       suspend s
  693.       }
  694.    Re_ParenGroups[groupNbr] := &null
  695. end
  696.  
  697.  
  698. procedure Re_WordBoundary(wd,nonwd)
  699. #
  700. #  Match word-boundary (\b)
  701. #
  702.    suspend ((pos(1),any(wd)) | (pos(0),move(-1),tab(any(wd))) | (move(-1),
  703.          (tab(any(wd)),any(nonwd)) | (tab(any(nonwd)),any(wd))),"")
  704. end
  705.  
  706.  
  707. procedure Re_NonWordBoundary(wd,nonwd)
  708. #
  709. #  Match non-word-boundary (\B)
  710. #
  711.    suspend ((pos(1),any(nonwd)) | (pos(0),move(-1),tab(any(nonwd))) | (move(-1),
  712.          (tab(any(wd)),any(wd)) | (tab(any(nonwd)),any(nonwd)),""))
  713. end
  714.  
  715.  
  716. procedure Re_MatchParenGroup(n)
  717. #
  718. #  Match same string matched by previous parenthesized group (\N)
  719. #
  720.    local s
  721.    suspend if s := \Re_ParenGroups[n] then =s else ""
  722. end
  723.  
  724.  
  725. ###################  Control Operation Procedures  ###################
  726.  
  727.  
  728. procedure Re_ArbNo(tok)
  729. #
  730. #  Match any number of times (*)
  731. #
  732.    suspend "" | (Re_tok_match(tok) & Re_ArbNo(tok))
  733. end
  734.  
  735.  
  736. procedure Re_OneOrMore(tok)
  737. #
  738. #  Match one or more times (+)
  739. #
  740.    suspend Re_tok_match(tok) & Re_ArbNo(tok)
  741. end
  742.  
  743.  
  744. procedure Re_NToMTimes(tok,n,m)
  745. #
  746. #  Match n to m times ({n,m}
  747. #
  748.    suspend Re_NTimes(tok,n) & Re_ArbNo(tok)\(m - n + 1)
  749. end
  750.  
  751.  
  752. procedure Re_NOrMoreTimes(tok,n)
  753. #
  754. #  Match n or more times ({n,})
  755. #
  756.    suspend Re_NTimes(tok,n) & Re_ArbNo(tok)
  757. end
  758.  
  759.  
  760. procedure Re_NTimes(tok,n)
  761. #
  762. #  Match exactly n times ({n})
  763. #
  764.    if n > 0 then
  765.       suspend Re_tok_match(tok) & Re_NTimes(tok,n - 1)
  766.    else suspend
  767. end
  768.  
  769.  
  770. procedure Re_ZeroOrOneTimes(tok)
  771. #
  772. #  Match zero or one times (?)
  773. #
  774.    suspend "" | Re_tok_match(tok)
  775. end
  776.  
  777.  
  778. procedure Re_Alt(tokList1,tokList2)
  779. #
  780. #  Alternation (|)
  781. #
  782.    suspend Re_match1(tokList1 | tokList2,1)
  783. end
  784.