;;;-*- Mode: Lisp; Package: FSA -*-

(in-package :fsa)

;; see fsa::RESOLVE() for string matching

(defclass feature-regexp ()
  ((dfa :initform nil :accessor regexp-dfa)
   (name :initform nil :initarg :name :accessor name)
   (source-regexp :initform nil :initarg :source-regexp :accessor source-regexp)))

(defmethod initialize-instance :after ((fr feature-regexp) &key source-regexp &allow-other-keys)
  (update-feature-regexp fr :source-regexp source-regexp))

(defun %remove-name (tree)
  (labels ((%remove (branch)
	     (cond ((atom branch)
		    branch)
		   ((and (listp (car branch))
			 (eq (caar branch) :name))
		    (%remove (cadr branch)))
		   (t
		    (mapcar #'%remove branch)))))
    (%remove tree)))

(defmethod update-feature-regexp ((fr feature-regexp) &key source-regexp)
  (with-slots (dfa) fr
    (setf dfa
      (fsa::dfa-compile-parsed-boolean-list
       (%remove-name source-regexp)
       (make-instance 'fsa::boolean-list-fsa)))))

;; convenience function
#+ignore
(defun filter (string &key (regexp *regexp-parser*) transduce-p)
  (let ((*sentence-class* 'regexp-sentence)
        (*token-class* 'regexp-token)
	(*cg* (gethash "nbo" *cg-table*)))
    (disambiguate-from-string
     string :cg *cg*
     :stream *standard-output*
     :print-function (lambda (sentence &key stream)
                       (print-matches (setf *sentence*
					(regexp-filter-sentence *cg* sentence :regexp regexp
								:transduce-p transduce-p))
				      :stream stream :expand-tokens-p nil
				      :transduce-p transduce-p)))))

:eof