;;; -*- mode: Lisp; Syntax: COMMON-LISP; coding: utf-8 -*-
;;; Solution by Luis Sergio Oliveira for the Beautiful Code exercise from
;;; Programming Praxis
;;; See http://programmingpraxis.com/2009/09/11/beautiful-code/
(defun empty (seq)
(declare (inline))
(= 0 (length seq)))
(defun match (re text)
"search for re anywhere in text"
(if (and (not (empty re)) (char= #\^ (elt re 0)))
(matchhere (subseq re 1) text)
;; must look at empty string
(cond ((matchhere re text))
((empty text)
nil)
((match re (subseq text 1))))))
(defun matchhere (re text)
"search for re at beginning of text"
(cond ((empty re))
((and (< 1 (length re)) (char= #\* (elt re 1)))
(matchstar (elt re 0) (subseq re 2) text))
((and (char= #\$ (elt re 0)) (= 1 (length re)))
(empty text))
((and (not (empty text))
(or (char= #\. (elt re 0)) (char= (elt re 0) (elt text 0))))
(matchhere (subseq re 1) (subseq text 1)))))
(defun matchstar (c re text)
"search for c*re at beginning of text"
(cond ((matchhere re text))
((and (not (empty text))
(or (char= c (elt text 0)) (char= #\. c)))
(matchstar c re (subseq text 1)))))
;;; Debugging helper:
;;; (trace matchstar matchhere match)
;;; (untrace)
(defun process-test-result (expected actual test-form)
(let ((result (equal expected actual)))
(format t (if result "." "F"))
(list result (apply #'format nil
(if result
(list "\"~a\" was successful." test-form)
(list "\"~a\" failed, expected ~a but got ~a."
test-form expected actual))))))
(defun tests-simple-re-match ()
(let ((results (list)))
(macrolet ((test-expression (expected &body test-form)
(let ((actual (gensym)))
`(let ((,actual ,@test-form))
(push (process-test-result ,expected ,actual ',@test-form)
results)))))
(test-expression t (match "ab" "abcd"))
(test-expression nil (match "ab" "aacd"))
(test-expression t (match ".a" "aacd"))
(test-expression t (match "a*c" "aacd"))
(test-expression t (match "a*c" "cd"))
(test-expression t (match "a*d" "cd"))
(test-expression nil (match "a*dd" "cd"))
(test-expression t (match "ola.*" "ola luis"))
(test-expression t (match "^ola..ui*s$" "ola luis"))
(test-expression t (match ".ui*s$" "ola luis"))
(test-expression t (match "a*" ""))
(test-expression nil (match "a" ""))
(test-expression nil (match "." ""))
(test-expression t (match "" "ola")) ; should this return NIL?
(test-expression t (match "^" "ola")); how about this?
;; test suite from Programming Praxis solution
;; http://programmingpraxis.codepad.org/vv72J3XE
(test-expression t (match "a" "a"))
(test-expression nil (match "a" "b"))
(test-expression t (match "a" "ab"))
(test-expression t (match "a" "ba"))
(test-expression t (match "ab" "ab"))
(test-expression nil (match "ab" "ba"))
(test-expression t (match "ab" "xab"))
(test-expression t (match "ab" "aab"))
(test-expression nil (match "a.c" "ac"))
(test-expression t (match "a.c" "abc"))
(test-expression nil (match "a.c" "xac"))
(test-expression t (match "a.c" "xabcx"))
(test-expression t (match "^ab" "ab"))
(test-expression nil (match "^ab" "ba"))
(test-expression nil (match "^ab" "aab"))
(test-expression t (match "^ab" "abc"))
(test-expression t (match "ab$" "ab"))
(test-expression nil (match "ab$" "ba"))
(test-expression t (match "ab$" "aab"))
(test-expression nil (match "ab$" "abc"))
(test-expression t (match "^ab$" "ab"))
(test-expression nil (match "^ab$" "ba"))
(test-expression nil (match "^ab$" "abc"))
(test-expression nil (match "^ab$" "aba"))
(test-expression t (match "a.*c" "ac"))
(test-expression t (match "a.*c" "abc"))
(test-expression t (match "a.*c" "abbc"))
(test-expression nil (match "a.*c" "cbba"))
(test-expression nil (match "aa*" "x"))
(test-expression t (match "aa*" "a"))
(test-expression t (match "aa*" "aa"))
(test-expression t (match "aa*" "ba"))
(test-expression t (match "a*a*a" "a"))
(test-expression t (match "a*a*a" "aaa"))
(test-expression nil (match "a*a*a" "xxxxx"))
(dolist (result results)
(unless (first result)
(format t "~&~a" (second result)))))))