53 lines
1.8 KiB
Racket
53 lines
1.8 KiB
Racket
#lang racket/base
|
|
(require "nfa.rkt"
|
|
(for-syntax syntax/parse
|
|
racket/syntax
|
|
unstable/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* ...) ...)
|
|
(syntax-map state->epsilons #'(start ...))]
|
|
[((((next-state* ...) ...) ...) ...)
|
|
(syntax-map (λ (ns*)
|
|
(syntax-map (λ (ns)
|
|
(syntax-map state->epsilons ns))
|
|
ns*))
|
|
#'(((next-state ...) ...) ...))])
|
|
(syntax/loc stx
|
|
(nfa (start* ... ...)
|
|
(end ...)
|
|
[state ([evt (next-state* ... ...)]
|
|
...)]
|
|
...)))]))
|
|
|
|
(provide epsilon
|
|
nfa/ep)
|