; beautiful code
(define (trex regex text)
(match (string->list regex) (string->list text)))
(define (match regex text)
(cond ((null? regex) #t)
((null? text) #f)
((char=? (car regex) #\^)
(match-here (cdr regex) text))
(else (or (match-here regex text)
(match regex (cdr text))))))
(define (match-here regex text)
(cond ((null? regex) #t)
((and (pair? (cdr regex))
(char=? (cadr regex) #\*))
(match-star (car regex) (cddr regex) text))
((and (char=? (car regex) #\$)
(null? (cdr regex)))
(null? text))
((and (pair? text)
(or (char=? (car regex) #\.)
(char=? (car regex) (car text))))
(match-here (cdr regex) (cdr text)))
(else #f)))
(define (match-star c regex text)
(cond ((match-here regex text) #t)
((and (pair? text)
(or (char=? (car text) c)
(char=? c #\.)))
(match-star c regex (cdr text)))
(else #f)))
(define-syntax assert
(syntax-rules ()
((assert expr result)
(if (not (equal? expr result))
(begin
(newline) (display "failed assertion:") (newline)
(display 'expr) (newline)
(display "expected: ") (display result) (newline)
(display "returned: ") (display expr) (newline))))
((assert descrip expr result)
(if (not (equal? expr result))
(begin
(newline) (display "failed assertion: ") (display descrip) (newline)
(display 'expr) (newline)
(display "expected: ") (display result) (newline)
(display "returned: ") (display expr) (newline))))))
(define (match-test)
(assert (trex "a" "a") #t)
(assert (trex "a" "b") #f)
(assert (trex "a" "ab") #t)
(assert (trex "a" "ba") #t)
(assert (trex "ab" "ab") #t)
(assert (trex "ab" "ba") #f)
(assert (trex "ab" "xab") #t)
(assert (trex "ab" "aab") #t)
(assert (trex "a.c" "ac") #f)
(assert (trex "a.c" "abc") #t)
(assert (trex "a.c" "xac") #f)
(assert (trex "a.c" "xabcx") #t)
(assert (trex "^ab" "ab") #t)
(assert (trex "^ab" "ba") #f)
(assert (trex "^ab" "aab") #f)
(assert (trex "^ab" "abc") #t)
(assert (trex "ab$" "ab") #t)
(assert (trex "ab$" "ba") #f)
(assert (trex "ab$" "aab") #t)
(assert (trex "ab$" "abc") #f)
(assert (trex "^ab$" "ab") #t)
(assert (trex "^ab$" "ba") #f)
(assert (trex "^ab$" "abc") #f)
(assert (trex "^ab$" "aba") #f)
(assert (trex "a.*c" "ac") #t)
(assert (trex "a.*c" "abc") #t)
(assert (trex "a.*c" "abbc") #t)
(assert (trex "a.*c" "cbba") #f)
(assert (trex "aa*" "x") #f)
(assert (trex "aa*" "a") #t)
(assert (trex "aa*" "aa") #t)
(assert (trex "aa*" "ba") #t)
(assert (trex "a*a*a" "a") #t)
(assert (trex "a*a*a" "aaa") #t)
(assert (trex "a*a*a" "xxxxx") #f)
)
(match-test) ; no news is good news