Skip to content

Instantly share code, notes, and snippets.

@et4te
Created August 29, 2011 15:24
Show Gist options
  • Select an option

  • Save et4te/1178614 to your computer and use it in GitHub Desktop.

Select an option

Save et4te/1178614 to your computer and use it in GitHub Desktop.
Regex Derivatives
;; base types
(defvar *regex-null* nil)
(defvar *regex-empty* t)
;; predicates
(defun regex-alt? (re)
(and (consp re) (eq (car re) 'alt)))
(defun regex-seq? (re)
(and (consp re) (eq (car re) 'seq)))
(defun regex-rep? (re)
(and (consp re) (eq (car re) 'rep)))
(defun regex-null? (re)
(eq re *regex-null*))
(defun regex-empty? (re)
(eq re *regex-empty*))
(defun regex-atom? (re)
(or (characterp re) (symbolp re)))
;; deconstructors
(defun match-seq (re f)
(and (regex-seq? re)
(funcall f (cadr re) (caddr re))))
(defun match-alt (re f)
(and (regex-alt? re)
(funcall f (cadr re) (caddr re))))
(defun match-rep (re f)
(and (regex-rep? re)
(funcall f (cadr re))))
;; simplified
(defun seq (pat1 pat2)
(cond ((regex-null? pat1) *regex-null*)
((regex-null? pat2) *regex-null*)
((regex-empty? pat1) pat2)
((regex-empty? pat2) pat1)
(t (list 'seq pat1 pat2))))
(defun alt (pat1 pat2)
(cond ((regex-null? pat1) pat2)
((regex-null? pat2) pat1)
(t (list 'alt pat1 pat2))))
(defun rep (pat)
(cond ((regex-null? pat) *regex-empty*)
((regex-empty? pat) *regex-empty*)
(t (list 'rep pat))))
;; matching
(defun regex-empty (re)
(cond ((regex-empty? re) *regex-empty*)
((regex-null? re) *regex-null*)
((regex-atom? re) *regex-null*)
((match-seq re (lambda (pat1 pat2)
(seq (regex-empty pat1) (regex-empty pat2)))))
((match-alt re (lambda (pat1 pat2)
(alt (regex-empty pat1) (regex-empty pat2)))))
((regex-rep? re) *regex-empty*)
(t *regex-null*)))
(defun regex-deriv (re c)
(cond ((regex-empty? re) *regex-null*)
((regex-null? re) *regex-null*)
((eq c re) *regex-empty*)
((regex-atom? re) *regex-null*)
((match-seq re (lambda (pat1 pat2)
(alt (seq (regex-deriv pat1 c) pat2)
(seq (regex-empty pat1) (regex-deriv pat2 c))))))
((match-alt re (lambda (pat1 pat2)
(alt (regex-deriv pat1 c)
(regex-deriv pat2 c)))))
((match-rep re (lambda (pat)
(seq (regex-deriv pat c) (rep pat)))))
(t *regex-null*)))
(regex-deriv '(seq #\a #\b #\c)
#\a)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment