src/shell/matching.slate

   1 define: #Glob &parents: {Cloneable} &slots: {}.
   2
   3 Glob traits define: #Pattern &parents: {Glob} &slots: {#components}.
   4 Glob traits define: #PatternMatcher &parents: {Glob} &slots: {#reader. #maskPattern}.
   5
   6 Glob traits define: #PatternFailure.
   7
   8 Glob traits define: #PatternComponent &parents: {Glob}.
   9 Glob traits define: #PatternLiteral &parents: {Glob PatternComponent} &slots: {#string -> ''}.
  10 Glob traits define: #PatternRange &parents: {Glob PatternComponent} &slots: {
  11   #ranges -> ExtensibleArray new.
  12   #negate -> False
  13 }.
  14 Glob traits define: #PatternAny &parents: {Glob PatternComponent}.
  15 Glob traits define: #PatternAnyOne &parents: {Glob PatternComponent}.
  16
  17 glob@(Glob traits) newOn: s
  18 [glob Pattern newOn: s].
  19
  20 glob@(Glob Pattern traits) newOn: s@(String traits)
  21 [
  22   glob components := ExtensibleArray new.
  23   glob readFrom: s reader.
  24   glob
  25 ].
  26
  27 glob@(Glob Pattern traits) readFrom: s@(ReadStream traits)
  28 [| prev |
  29   prev := '' writer.
  30   glob components :=
  31     [| :matcher |
  32      s do:
  33        [| :token |
  34         (#{$*. $?. $\[. } includes: token) /\ [prev contents isEmpty not]
  35           ifTrue: [matcher nextPut: (glob PatternLiteral new `>> [string := prev contents. ]).
  36                    prev := '' writer].
  37         token caseOf: {
  38           $*  -> [matcher nextPut: glob PatternAny].
  39           $?  -> [matcher nextPut: glob PatternAnyOne].
  40           $\[ -> [matcher nextPut: (glob readRange := s upTo: $\])]
  41         } otherwise: [prev nextPut: token]].
  42      prev contents isEmpty ifFalse: [matcher nextPut: (glob PatternLiteral new `>> [string := prev contents. ])]] writingAs: glob components.
  43 ].
  44
  45 glob@(Glob Pattern traits) readRange: str@(String traits)
  46 [| p char2 s |
  47   s := str reader.
  48   p := glob PatternRange new `>>
  49     [| :p |
  50      ranges := p ranges new.
  51      negate := '^!' includes: (char2 := s peek). ].
  52   s do:
  53     [| :char |
  54      (char2 := s peek) = $-
  55        ifTrue: [s next. p ranges addLast: char -> s next]
  56        ifFalse: [p ranges addLast: char]].
  57   p
  58 ].
  59
  60 glob@(Glob Pattern traits) match: str@(String traits) from: pos
  61 [
  62   (glob PatternMatcher new `>> [maskPattern := glob. reader := glob components reader. ]) match: str from: pos
  63 ].
  64
  65 glob@(Glob PatternMatcher traits) match: str@(String traits) from: pos
  66 [
  67   "inform: 'match reader: ' ; glob reader printString ;  ' pos: ' ; pos printString."
  68   glob reader do:
  69     [| :token |
  70      (token isSameAs: glob PatternAny)
  71        ifTrue: [str size downTo: pos do:
  72                   [| :start | ((glob new `>> [reader := glob reader clone. ]) match: str from: start) = str size
  73                                ifTrue: [^ str size]]]
  74        ifFalse: [(pos := (token match: str from: pos))
  75                    == glob PatternFailure ifTrue: [^ pos]]].
  76   pos
  77 ].
  78
  79 glob@(Glob Pattern traits) matches: str@(String traits)
  80 [
  81   (match ::= glob match: str from: 0) ~== glob PatternFailure /\ [match = str size]
  82 ].
  83
  84 glob@(Glob PatternAny traits) match: str@(String traits) from: pos
  85 [
  86   (pos to: str size - pos)
  87 ].
  88
  89 glob@(Glob PatternAnyOne traits) match: str@(String traits) from: pos
  90 [
  91   pos >= str size ifTrue: [glob PatternFailure] ifFalse: [pos + 1]
  92 ].
  93
  94 glob@(Glob PatternRange traits) match: str@(String traits) from: pos
  95 [
  96   pos >= str size \/ [glob matches: (str at: pos)] ifTrue: [glob PatternFailure] ifFalse: [pos + 1]
  97 ].
  98
  99 glob@(Glob PatternLiteral traits) match: str@(String traits) from: pos
 100 [
 101   pos + glob string size > str size ifTrue: [^ glob PatternFailure].
 102   (str copyFrom: pos to: pos + glob string size - 1) = glob string ifTrue: [pos + glob string size] ifFalse: [glob PatternFailure]
 103 ].
 104
 105 glob@(Glob PatternRange traits) matches: c@(String Character traits)
 106 [
 107   glob ranges detect:
 108     [| :range | ((range isSameAs: c) /\ [range = c]) \/
 109                   [c code between: range key code and: c code]]
 110 ].