#lang racket/base
(require "nfa.rkt"
         (for-syntax syntax/parse
                     syntax/stx
                     racket/syntax
                     syntax/id-table
                     racket/dict
                     racket/list
                     racket/base))

(define-syntax (epsilon stx) (raise-syntax-error 'epsilon "Outside nfa/ep" stx))
(define-syntax (nfa/ep stx)
  (syntax-parse
   stx
   #:literals (epsilon)
   [(_ (start:id ...)
       (end:id ...)
       [state:id ([epsilon (epsilon-state:id ...)]
                  ...
                  [evt:expr (next-state:id ...)]
                  ...)]
       ...)
    (define state->epsilon (make-bound-id-table))
    (for ([stx (in-list (syntax->list #'([state epsilon-state ... ...] ...)))])
      (syntax-case stx ()
        [[state . es]
         (bound-id-table-set! state->epsilon #'state (syntax->list #'es))]))
    (define seen? (make-parameter (make-immutable-bound-id-table)))
    (define (state->epsilons state)
      (if (dict-has-key? (seen?) state)
          empty
          (parameterize ([seen? (bound-id-table-set (seen?) state #t)])
            (define es (bound-id-table-ref state->epsilon state empty))
            (list* state (append-map state->epsilons es)))))
    (with-syntax*
        ([((start* ...) ...)
          (stx-map state->epsilons #'(start ...))]
         [((((next-state* ...) ...) ...) ...)
          (stx-map (λ (ns*)
                     (stx-map (λ (ns)
                                (stx-map state->epsilons ns))
                              ns*))
                   #'(((next-state ...) ...) ...))])
      (syntax/loc stx
        (nfa (start* ... ...)
             (end ...)
             [state ([evt (next-state* ... ...)]
                     ...)]
             ...)))]))

(provide epsilon
         nfa/ep)
