;;; utility functions for creating primitive FSA's

;; helpers

(define (object->string obj)
  "return a natural string representation for some objects, as what display would show"
  (cond ((number? obj) (number->string obj))
	((char? obj) (string obj))
	((string? obj) obj)
	((symbol? obj) (symbol->string obj))
	(else (error "object->string: problematic object: " obj))))

(define (crossmap f ls1 ls2)
  (append-map (lambda (x1) (map (lambda (x2) (f x1 x2)) ls2)) ls1))

;; primitive FSA's

; these are constructors for some primitive FSA's: fsa-item,
; fsa-failure, fsa-success, fsa-any-item

(define (fsa-item item)
  "return a FSA that accepts an input consisting only of item
  > (fsa-item 'dark) => '(fsa S1 (S2) ((S1 dark S2))) "
  (fsa-sequence (list item)))

(define (fsa-sequence seq)
  "return a FSA that only accepts the exact input sequence seq
  > (fsa-sequence '(foo bar)) => '(fsa S3 (S5) ((S3 foo S4) (S4 bar S5)))
  > (fsa-sequence '()) => '(fsa S6 (S6) ()) "
  (if (null? seq) (fsa-success)
    (let* ((item (car seq))
	   (input (make-input item))
	   (name (object->string item))
	   (start-state (generate-state (string-append "pre-" name)))
	   (rest-fsa (fsa-sequence (cdr seq)))
	   (new-transition (make-transition start-state input
					    (fsa-start-state rest-fsa))))
      (make-fsa start-state (fsa-goal-states rest-fsa)
		(cons new-transition (fsa-transitions rest-fsa))))))

(define (fsa-failure)
  "return a FSA that does not accept anything
  > (fsa-failure) => '(fsa S3 () ()) "
  (make-fsa (generate-state "failure") '() '()))

(define (fsa-success)
  "return a FSA that accepts an empty input (and nothing else)
  > (fsa-success) => '(fsa S4 (S4) ()) "
  (let ((success-state (generate-state "success")))
    (make-fsa success-state (list success-state) '())))

(define (fsa-any-item)
  "return a FSA that accepts an input consisting of exactly one item
  > (fsa-any-item) => '(fsa S5 (S6) ((S5 (not) S6))) "
  (let ((start-state (generate-state "pre-any"))
	(end-state (generate-state "post-any")))
    (make-fsa
      start-state (list end-state)
      (list (make-transition start-state (make-input-except) end-state)))))

(define (fsa-anything)
  "return a fsa that accepts anything.
  > (fsa-anything) => '(fsa S2 (S2) ((S2 (not) S2))) "
  (let ((state (generate-state "any")))
    (make-fsa state (list state)
	      (list (make-transition state (make-input-except) state)))))