anchor.diff:  (in-package :com.rrette.finenight)
   (provide :com.rrette.finenight.iadfa)
   
  -(require :com.rrette.finenight.fsa "fsa.lisp")
  +(require :com.rrette.finenight.fsa "fsa-scm.lisp")
   ;(require :com.rrette.finenight.utils "utils.lisp")
   
   (defstruct iadfa 
  
positive.code:   ;; this function takes a suffix to be consumed
    ;; and a node to start from and the current stem
    (labels ((c-suffix (iadfa current-suffix node profile)
  		     (if (eq? 1 (length current-suffix))
  			 (cons node (reverse current-suffix))
  		       (let ((next-node (ancestror-transition iadfa node (car current-suffix) (car profile))))
  			 (if (or (not next-node) (eq? next-node (fsa-start-node (iadfa-fsa iadfa))))
  			     (cons node (reverse current-suffix))
  			   (c-suffix iadfa
  				     (cdr current-suffix)
  
negative.code:   fsa
    final)
  
  (defun ancestror-transition (iadfa node input final)
    (let ((ancestrors (aref (iadfa-ancestrors iadfa) (node-label node))))
      (if (not ancestrors)
  	nil
        (let ((src-nodes (filter (lambda (node)
  				 (eq (node-final node) final))
  			       (gethash input ancestrors '()))))
  	(if (null src-nodes)
  	    nil
  	  (car src-nodes))))))
  
  (defun node-add-ancestror! (iadfa dst-node input src-node)
    (let ((ancestrors (aref (iadfa-ancestrors iadfa) (node-label dst-node))))
      (if (not ancestrors)
  	(progn
  	  (setf ancestrors (make-hash-table))
  	  (setf (aref (iadfa-ancestrors iadfa) (node-label dst-node)) ancestrors)))
      (hash-table-update!	(lambda (nodes)
  			  (cons src-node nodes))
  			input
  			ancestrors)))
      
  (defun node-remove-ancestror! (iadfa dst-node input src-node)
    (let ((ancestrors (aref (iadfa-ancestrors iadfa) (node-label dst-node))))
      (if ancestrors
  	(progn 
  	  (hash-table-update! (lambda (nodes)
  				(remove (lambda (node)
  					  (eq node src-node))
  					nodes))
  			      ancestrors
  			      input)))))
  
  (defun remove-ancestror-to-childs (iadfa node)
    (node-walk node (lambda (input destination-nodes)
  		    (for-each (lambda (dst-node)
  				(node-remove-ancestror! iadfa dst-node input node))
  			      destination-nodes))))
  
  (defun delete-branch (iadfa stem-start-node stem-start-input stem-end-node)
    (remove-ancestror-to-childs iadfa stem-end-node)
    (node-remove-dsts-for-input! stem-start-node stem-start-input))
  
  
  (defun build-fsa-from-ancestrors (iadfa)
    (let ((fsa (make-empty-fsa-builder 0)))
      (vector-walk
       (iadfa-ancestrors iadfa)
       (lambda (label node-ancestrors)
         (if node-ancestrors
  	   (maphash
  	    (lambda (input nodes)
  	      (for-each
  	       (lambda (node)
  		 (fsa-add-edge! fsa label input (node-label node)))
  	       nodes))
  	    node-ancestrors))))
      fsa))
      
  (defun iadfa-state-ancestrors (iadfa dst-label input)
    (let ((ancestrors (aref (iadfa-ancestrors iadfa) dst-label)))
      (if ancestrors
  	(mapcar (lambda (node)
  		  (node-label node))
  		(gethash input ancestrors))
        '())))
      
  (defun node-ancestrors (iadfa dst-node input)
    (iadfa-state-ancestrors iadfa (node-label dst-node) input))
      
  (defun generate-state (iadfa)
    (let ((name (iadfa-index iadfa)))
      (setf (iadfa-index iadfa) (+ 1 (iadfa-index iadfa)))
      name))
  
  (defun build-iadfa ()
    (let ((iadfa (make-iadfa (make-array 100000 :initial-element nil)
  			   2
  			   (make-fsa (make-empty-node 0))
  			   (make-empty-node 1))))
      (setf (node-final (iadfa-final iadfa)) t)
      iadfa))
  
  (defun common-prefix (iadfa word node)
    (let ((stem '())
  