home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / CLIPPER / MISC / BIPL.ZIP / PROCS.ZIP / WILDCARD.ICN < prev    next >
Encoding:
Text File  |  1992-09-28  |  5.5 KB  |  183 lines
  1. ############################################################################
  2. #
  3. #    File:     wildcard.icn
  4. #
  5. #    Subject:  Procedures for UNIX-like wild-card pattern matching
  6. #
  7. #    Author:   Robert J. Alexander
  8. #
  9. #    Date:     September 26, 1990
  10. #
  11. ###########################################################################
  12. #
  13. #  This is a kit of procedures to deal with UNIX-like filename wild-card
  14. #  patterns containing *, ?, and [...].  The meanings are as of the
  15. #  pattern characters are the same as in the UNIX shells csh and sh.
  16. #  They are described briefly in the wild_pat() procedure.
  17. #
  18. #  These procedures are interesting partly because of the "recursive
  19. #  suspension" technique used to simulate conjunction of an arbitrary
  20. #  number of computed expressions.
  21. #
  22. #
  23. #  The public procedures are:
  24. #
  25. #  wild_match(pattern,s,i1,i2) : i3,i4,...,iN
  26. #  wild_find(pattern,s,i1,i2) : i3,i4,...,iN
  27. #
  28. #  wild_match() produces the sequence of positions in "s" past a
  29. #  substring starting at "i1" that matches "pattern", but fails if there
  30. #  is no such position.  Similar to match(), but is capable of
  31. #  generating multiple positions.
  32. #
  33. #  wild_find() produces the sequence of positions in "s" where
  34. #  substrings begin that match "pattern", but fails if there is no such
  35. #  position.  Similar to find().
  36. #
  37. #  "pattern" can be either a string or a pattern list -- see wild_pat(),
  38. #  below.
  39. #
  40. #  Default values of s, i1, and i2 are the same as for Icon's built-in
  41. #  string scanning procedures such as match().
  42. #
  43. #
  44. #  wild_pat(s) : L
  45. #
  46. #  Creates a pattern element list from pattern string "s".  A pattern
  47. #  element is needed by wild_match() and wild_find().  wild_match() and
  48. #  wild_find() will automatically convert a pattern string to a pattern
  49. #  list, but it is faster to do the conversion explicitly if multiple
  50. #  operations are done using the same pattern.
  51. #
  52.  
  53. procedure wild_match(plist,s,i1,i2) # i3,i4,...,iN
  54. #
  55. #  Produce the sequence of positions in s past a string starting at i1
  56. #  that matches the pattern plist, but fails if there is no such
  57. #  position.  Similar to match(), but is capable of generating multiple
  58. #  positions.
  59. #
  60.    /i1:= if /s := &subject then &pos else 1 ; /i2 := 0
  61.    plist := (if type(plist) == "string" then wild_pat else copy)(plist)
  62.    suspend s[i1:i2] ? (wild_match1(plist) & i1 + &pos - 1)
  63. end
  64.  
  65.  
  66. procedure wild_find(plist,s,i1,i2) # i3,i4,...,iN
  67. #
  68. #  Produce the sequence of positions in s where strings begin that match
  69. #  the pattern plist, but fails if there is no such position.  Similar
  70. #  to find().
  71. #
  72.    local p
  73.    /i1 := if /s := &subject then &pos else 1 ; /i2 := 0
  74.    if type(plist) == "string" then plist := wild_pat(plist)
  75.    s[i1:i2] ? suspend (
  76.      wild_skip(plist) &
  77.      p := &pos &
  78.      tab(wild_match(plist))\1 &
  79.      i1 + p - 1)
  80. end
  81.  
  82.  
  83. procedure wild_pat(s) # L
  84. #
  85. #  Produce pattern list representing pattern string s.
  86. #
  87.    local c,ch,chars,complement,e,plist,special
  88.    #
  89.    #  Create a list of pattern elements.  Pattern strings are parsed
  90.    #  and converted into list elements as follows:
  91.    #
  92.    #    * --> 0            Match any substring (including empty)
  93.    #    ? --> 1            Matches any single character
  94.    #    [abc] --> 'abc'        Matches single character in 'abc' (more below)
  95.    #    abc --> "abc"        Matches "abc"
  96.    #    \            Escapes the following character, causing it
  97.    #                to be considered part of a string to match
  98.    #                rather than one of the special pattern
  99.    #                characters.
  100.    #
  101.    plist := []
  102.    s ? {
  103.       until pos(0) do {
  104.      c := &null
  105.      #
  106.      #  Put pattern element on list.
  107.      #
  108.      e := (="*" & 0) | (="?" & 1) | (="\\" & move(1)) |
  109.            (="[" & c := (=("]" | "!]" | "!-]" | "") || tab(find("]"))) &
  110.              move(1)) |
  111.            move(1) || tab(upto('*?[\\') | 0)
  112.      #
  113.      #  If it's [abc], create a cset.  Special notations:
  114.      #
  115.      #       A-Z means all characters from A to Z inclusive.
  116.      #       ! (if first) means any character not among those specified.
  117.      #       - or ] (if first, or after initial !) means itself.
  118.      #
  119.      \c ? {
  120.         complement := ="!" | &null
  121.         special := '-]'
  122.         e := ''
  123.         while ch := tab(any(special)) do {
  124.            e ++:= ch
  125.            special --:= ch
  126.            }
  127.         while chars := tab(find("-")) do {
  128.            move(1)
  129.            e ++:= chars[1:-1] ++
  130.              &cset[ord(chars[-1]) + 1:ord(move(1)) + 2]
  131.            }
  132.         e ++:= tab(0)
  133.         if \complement then e := ~e
  134.         }
  135.      if type(e) == "string" == type(plist[-1]) then plist[-1] ||:= e
  136.      else put(plist,e)
  137.      }
  138.       }
  139.    return plist
  140. end
  141.  
  142.  
  143. procedure wild_skip(plist) # s1,s2,...,sN
  144. #
  145. #  Used privately -- match a sequence of strings in s past which a match
  146. #  of the first pattern element in plist is likely to succeed.    This
  147. #  procedure is used for heuristic performance improvement by
  148. #  wild_match() for the "*" pattern element by matching only strings
  149. #  where the next element is likely to succeed, and by wild_find() to
  150. #  attempt matches only at likely positions.
  151. #
  152.    local x,t
  153.    x := plist[1]
  154.    suspend tab(
  155.       case type(x) of {
  156.      "string": find(x)
  157.      "cset": upto(x)
  158.      default: &pos to *&subject + 1
  159.      }
  160.       )
  161. end
  162.  
  163.  
  164. procedure wild_match1(plist,v) # s1,s2,...,sN
  165. #
  166. #  Used privately by wild_match() to simulate a computed conjunction
  167. #  expression via recursive suspension.
  168. #
  169.    local c
  170.    if c := pop(plist) then {
  171.       suspend wild_match1(plist,case c of {
  172.      0: wild_skip(plist)
  173.      1: move(1)    
  174.      default: case type(c) of {
  175.            "cset": tab(any(c))
  176.            default: =c
  177.            } 
  178.      })
  179.       push(plist,c)
  180.       }
  181.    else return v
  182. end
  183.