Implementation of the presentation "Regex to NFA Conversion Isn't Hard! (Sipser 1.28a)" for Chez Scheme Version 9.5.4

nfa.svg

RX2NFA.scm

;; Implementation of the presentation "Regex to NFA Conversion Isn't
;; Hard! (Sipser 1.28a)" available at https://youtu.be/VbR1mGdP99s for
;; Chez Scheme Version 9.5.4.
;;
;; Usage: scheme --script rx2nfa.scm | dot -Tsvg > nfa.svg

;; Functions lacking in R6RS.

(define (make-equal-hashtable)
  (make-hashtable equal-hash equal?))

(define (hashtable-map h p)
  (let-values (((k v) (hashtable-entries h)))
    (map p (vector->list k) (vector->list v))))

(define (hashtable->alist h)
  (hashtable-map h cons))

;; Create a sequential number to name states.

(define next-state-id
  (let ((n 0))
    (lambda ()
      (set! n (+ n 1))
      (number->string n))))

;; The record for a state contains a sequential number and a hash
;; table for outgoing transitions.

(define-record-type (State state state?)
  (fields (immutable id state.id)
          (immutable ht state.ht))
  (protocol (lambda (new)
              (lambda ()
                (new (next-state-id)
                     (make-eqv-hashtable))))))

;; Add an additional outgoing transition to a state.

(define (state:out! s0 via s1)
  (hashtable-set! (state.ht s0) via s1))

;; Mapping a state means mapping over the outgoing transitions.
;; Execute `p` for each outgoing transition of the state `from`.

(define (state:map from p)
  (hashtable-map (state.ht from) p))

;; Add an ε-transition.

(define (state:epsilon! s0 s1)
  ;(printf "epsilon: ~a ~a" (state.id s0) (state.id s1))
  (state:out! s0 (list->string (list #\ε)) s1))

;; The record for a NFA contains one start state and a list of final
;; states.

(define-record-type (Nfa nfa nfa?)
  (fields (immutable start nfa.start)
          (mutable final nfa.final nfa.final!))
  (protocol (lambda (new)
              (lambda (start . final)
                (new start (or (and (pair? final)
                                    (car final))
                               (list)))))))

;; Add an additional final state `fs` to the NFA `n`.

(define (nfa:add! n fs)
  (nfa.final! n (cons fs (nfa.final n))))

;; Create a NFA for the string `s`.

(define (nfa:token s)
  (let ((s0 (state))
        (s1 (state)))
    (state:out! s0 s s1)
    (nfa s0 (list s1))))

;; Concatenate the two NFAs `n0` and `n1`.

(define (nfa:concat n0 n1)
  (let ((n1s (nfa.start n1)))
    (for-each (lambda (f)
                (state:epsilon! f n1s))
              (nfa.final n0))
    (nfa (nfa.start n0)
         (nfa.final n1))))

;; Create the Kleene star of the NFA `n`.

(define (nfa:star n)
  (let ((s (state))
        (nf (nfa.final n)))
    (state:epsilon! s (nfa.start n))
    (for-each (lambda (f)
                (state:epsilon! f s))
              nf)
    (nfa s (cons s nf))))

;; Create a union of two NFAs `n0` and `n1`.

(define (nfa:union n0 n1)
  (let ((s (state)))
    (state:epsilon! s (nfa.start n0))
    (state:epsilon! s (nfa.start n1))
    (nfa s (append (nfa.final n0)
                   (nfa.final n1)))))

;; Examples from https://youtu.be/VbR1mGdP99s

(define |a|         (nfa:token  "a"))
(define |b|         (nfa:token  "b"))
(define |ab|        (nfa:concat |a| |b|))
(define |abb|       (nfa:concat |ab| (nfa:token "b")))
(define |(abb)*|    (nfa:star   |abb|))
(define |a(abb)*|   (nfa:concat (nfa:token "a") |(abb)*|))
(define |a(abb)*∪b| (nfa:union  |a(abb)*| (nfa:token "b")))

;; Traverse all states of the NFA `n` and apply `p` once to each
;; transition of `n`.  Return a hash mapping every transition to the
;; return value of `p` for the transition.

(define (nfa:traverse n p)
  (let ((r (make-equal-hashtable)))
    (define (traverse from)
      (state:map from (lambda (via into)
                        (let ((trans (cons (state.id from) (state.id into))))
                          (if (not (hashtable-contains? r trans))
                            (begin
                              (hashtable-set! r trans (p from via into))
                              (traverse into)))))))
    (traverse (nfa.start n))
    r))

;; Format the NFA with Graphviz.

(define (nfa:graphviz n)
  (let ((edges (vector->list
                (hashtable-values
                 (nfa:traverse n (lambda (from via into)
                                   (format "~s -> ~s [ label=~s ];"
                                           (state.id from)
                                           (state.id into)
                                           via))))))
        (fins (map (lambda (s)
                     (format "~s [ shape=doublecircle ];" (state.id s)))
                   (nfa.final n))))
    (printf "~{~a~%~}"
            `("digraph nfa {"
              "rankdir=\"LR\";"
              "node [ shape=circle ];"
              ,@fins
              ,@edges
              "}"))))

(nfa:graphviz |a(abb)*∪b|)