[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/vv72J3XE    [ raw code | fork ]

programmingpraxis - Scheme, pasted on Sep 4:
; 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


Output:
No errors or program output.


Create a new paste based on this one


Comments: