pattern: Do not use record matching.

Mes does not support it, and also the code is cleaner without it!

* gash/pattern.scm (pattern-match?, pattern-drop)
(pattern-drop-right): Avoid record matching.
This commit is contained in:
Timothy Sample 2022-11-08 09:46:25 -06:00
parent 10ee7d286e
commit 7fb21c1549
1 changed files with 15 additions and 17 deletions

View File

@ -249,7 +249,7 @@ source string is the only string that will match it."
(let ((start* (+ m (vector-length part)))) (let ((start* (+ m (vector-length part))))
(parts-match? rest start*))))))) (parts-match? rest start*)))))))
(match-let ((($ <pattern> parts) pattern)) (let ((parts (pattern-parts pattern)))
(if (and explicit-initial-period? (if (and explicit-initial-period?
(< start end) (< start end)
(char=? (string-ref str start) #\.)) (char=? (string-ref str start) #\.))
@ -276,13 +276,12 @@ source string is the only string that will match it."
(#f str) (#f str)
(m (match-parts rest (+ m (vector-length part)))))))) (m (match-parts rest (+ m (vector-length part))))))))
(match-let ((($ <pattern> parts) pattern)) (match (pattern-parts pattern)
(match parts (() str)
(() str) ((part . rest)
((part . rest) (if (string-starts-with-part str part)
(if (string-starts-with-part str part) (match-parts rest (vector-length part))
(match-parts rest (vector-length part)) str))))
str)))))
(define* (pattern-drop-right pattern str #:key greedy?) (define* (pattern-drop-right pattern str #:key greedy?)
(define (match-parts parts i) (define (match-parts parts i)
@ -295,12 +294,11 @@ source string is the only string that will match it."
(#f str) (#f str)
(m (match-parts rest m)))))) (m (match-parts rest m))))))
(match-let ((($ <pattern> parts) pattern)) (let ((strap (reverse (pattern-parts pattern))))
(let ((strap (reverse parts))) (match strap
(match strap (() str)
(() str) ((part . rest)
((part . rest) (if (string-ends-with-part str part)
(if (string-ends-with-part str part) (let ((i (- (string-length str) (vector-length part))))
(let ((i (- (string-length str) (vector-length part)))) (match-parts rest i))
(match-parts rest i)) str)))))
str))))))