;; how can we extend the representtion of FSTs to include those that
;; require two simultaneous input streams?
;;	. a subclass
;;	. modify state-table->finite-state-transducer
;;	. 
(defclass fst ()
  ((alphabet-list :type 'list
		  :initform nil
		  :initarg :alphabet-list
		  :accessor alphabets
		  :allocation :instance)
   (state-list :type 'list
	       :initform nil
	       :initarg :state-list
	       :accessor state-list
	       :allocation :instance
	       :documentation "list of states")
   (initial-state :type 'transducer-state
		  :initform nil
		  :initarg :initial-state
		  :accessor initial-state
		  :allocation :instance))
  (:documentation "finite state transducer"))

(defclass transducer-state ()
  ((input-nextstate-output-list
    :initform nil
    :initarg :ino
    :type 'list
    :accessor get-states
    :allocation :instance
    :documentation
    "a list of triples '(current-input next-state output) specifiying the next state, and output action for given input")
   (name
    :initform ""
    :initarg :state-name
    :type 'string
    :accessor state-name
    :allocation :instance
    :documentation
    "name of the state"))
  (:documentation
   "fuck yer face"))

(defmacro trans-maker (name)
  "returns a new instance of a transducer-state object such that <name>, a string, will be a symbol whose symbol-value is that transducer-state" 
  `(eval (setf ,(string->symbol `,name) (make-instance 'transducer-state))))

(defmacro object-maker (name obj-type)
  "returns a new instance of an obj-type (symbol) object such that
<name>, a string, will be a symbol whose symbol-value is that
object"
  `(eval (setf ,(string->symbol `,name) (make-instance ,obj-type))))

(defmacro string->symbol (name)
  "returns the symbol whose symbol-name is the string <name>"
  `(read-from-string ,name))

;; table format
'(		
	  ;state name     ;input alphabet	
			  (a     b      c )

	  (q0             (q1 0) (q2 1) (q0 1)) ;next-state output pairs
	  (q1		(q0 1) (q0 0) (q3 1))
	  (q2		(q2 0) (q1 1) (q1 0))
	  (q3		(q1 0) (q1 0) (q0 1))


  )


  ;; a finite-state transducer can have more than one input string at a
  ;; time.  then the input alphabet table entry should be checked for
  ;; length.  It will be alist of lists s.t. each list will represent
  ;; one input varaible.  The length of each state's transition tuple
  ;; will increase by one for each additional input string.  the
  ;; alphabet lists must be the same length.  In this case, the table
  ;; specification should actually have (for the rows) the state name,
  ;; and any number of tuples, where each tuple will have the next state
  ;; and n-more elements from input alphabets where n == number of input
  ;; strings (input variables)

;; for one input string first
(defmethod fst-process ((machine fst) &rest string-list)
  (case (length string-list)
					;(3 (format t "lenght is three~%"))
    (2 (format t "lenght is two~%"))
    (1 (process-fst-one-input machine (car string-list)))
    (otherwise (format t "C.S.T.L. only supports FSTs with 1-2 input vars~%"))))


;; for each character of the input string
;;	if there is a tuple belonging to this-state
;;	with the correct input,
;;		concatenate its output onto out
;;		make the next state of this-state this-state and continue
;;	else
;;		print "undefined blah blah"
;;		return nil
;;	endif
;; 

(defmethod process-fst-one-input ((machine fst) input-string)
  (let ((this-state (initial-state machine))
	(out ()))
    (map nil #'(lambda (c)
		 (if (in-alphabet c (alphabets machine))
		     (let ((pos (position
				 (read-from-string (string c))
				 (alphabets machine))))
		       (format t "in there like swimweare at position ~A~%" pos)
		       (let ((tuple (elt (get-states this-state) pos)))
			 (format t "the tuple: ~A~%" (get-states this-state))
			 ;we now have the tuple that holds the next state (car) and the output (cadr)
			 ;so we need to set this-state to be the state whose state-name is the car
			 ;and concatenate the cadr onto out
			 (let ((next (car
				      (member (car tuple) (state-list machine)
					      :test #'(lambda (x y)
							(equal x (state-name y)))))))
			   (setf this-state next)
			   (push (cadr tuple) out))))
		     (progn
		       (format t "that shit ain't in there, punk!~%") ;set flag to indicate it can't process! somehow return
		       )))
	 input-string)
    (reverse out)))


;; example
(setf fyf (state-table->finite-state-transducer '( (a     b      c )
	  (q0             (q1 0) (q2 1) (q0 1))
	  (q1		(q0 1) (q0 0) (q3 1))
	  (q2		(q2 0) (q1 1) (q1 0))
	  (q3		(q1 0) (q1 0) (q0 1)))))
(setf (initial-state fyf ) (car (reverse (state-list fyf))))
;; probably should make state-table->finite-state-transducer make the first state encountered to initial state (optionally)


(defun in-alphabet (c alphabet)
  (member c alphabet :test #'(lambda (a b)
			       (char= a (char (symbol-name b) 0)))))



;; first get this to work before modifying the whole shit.
;; one step at a time... 
(defun state-table->finite-state-transducer (table)
  (let* ((alphabet (car table))
	 (states (cdr table))
	 (st-list nil)
	 (eff-ess-tee (make-instance 'fst :alphabet-list alphabet)))
    (dolist (st states)
      (let ((temp-state (make-instance 'transducer-state :state-name (car st)))
	    (temp-lst nil))
	    (dolist (tuple (cdr st))
	      (push tuple temp-lst))
	    (setf (get-states temp-state)  temp-lst)
	    (push temp-state st-list)))
    (setf (state-list eff-ess-tee) (reverse st-list))
    eff-ess-tee))