src/shell/matching.slate

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