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