[plt-scheme] The Swine Before Perl

> I turns out that this change is not that easy (at least for me). So I tried 
> something uglier first:
>
> (automaton init
>             (init : (c -> loop do nop))
>             (loop : (a -> loop do count)
>                     (d -> loop do nop)
>                     (r -> end do nop))
>             (end  : (r -> end do nop)))
>
> That was simple. But far from what I wanted.


Hi Jaime,

Still, this code may be useful.  It should be possible to transform an 
automaton of the form you want into the "normalized" automatons that your 
cases can handle.

We might even write a small helper function to make our lives easier. 
Let's start off with a simple one that knows how to expand actionless 
transition clauses with the "do no-op" thing:


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (define (expand-transition stx)
     (syntax-case stx (-> do)
       [(cndn -> new-state)
        #'(cndn -> new-state do no-op)]
       [else stx]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


For example:

;;;;;;
> (syntax-object->datum (expand-transition #'(c -> loop)))
(c -> loop do no-op)
;;;;;;



Next, we might also want a handler to help expand a whole state clause 
with its transitions:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   (define (expand-state/transitions stx)
     (syntax-case stx (:)
       [(state : transitions ...)
        (with-syntax ([(expanded-transitions ...)
                       (map expand-transition
                            (syntax->list #'(transitions ...)))])
        #'(state : expanded-transitions ...))]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Let's exercise this code:

;;;;;;
> (syntax-object->datum
    (expand-state/transitions
     #'(loop : (a -> loop do count)
               (d -> loop))))
(loop : (a -> loop do count) (d -> loop do no-op))
;;;;;;;

Yeah!  *grin*  That looks reasonable.


Given these helper functions, writing the automaton macro we want should 
be a lot simpler.  Here is some code that does what you want, using those 
helper functions above (as well as your original automaton macro!):


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module automata mzscheme
   (require (lib "list.ss")
            (lib "etc.ss"))

   (define-syntax automaton
     (syntax-rules (-> : do)
       ((_ init-state
           (state : (cndn -> new-state do action) ...)
           ...)
        (letrec ([state
                  (lambda (stream)
                    (or (empty? stream)
                        (case (first stream)
                          [(cndn) (action) (new-state (rest stream))]
                          ...
                          [else false])))]
                 ...)
          init-state))))

   (define (no-op) (void))

   (define-syntax (automaton* stx)
     (define (expand-transition stx)
       (syntax-case stx (-> do)
         [(cndn -> new-state)
          #'(cndn -> new-state do no-op)]
         [else stx]))


     (define (expand-state/transitions stx)
       (syntax-case stx (:)
         [(state : transitions ...)
          (with-syntax ([(expanded-transitions ...)
                         (map expand-transition
                              (syntax->list #'(transitions ...)))])
            #'(state : expanded-transitions ...))]))

     (syntax-case stx ()
       [(_ init-state state/transitions ...)
        (with-syntax ([(expanded-state/transitions ...)
                       (map expand-state/transitions
                            (syntax->list #'(state/transitions ...)))])
          #'(automaton init-state expanded-state/transitions ...))]))


   (define (make-debug-action s)
     (lambda ()
       (printf "I see ~a~n" s)))

   (define my-automaton
     (automaton* init
                 (init : (c -> loop do (make-debug-action 'c)))
                 (loop : (a -> loop)
                         (d -> loop do (make-debug-action 'd))
                         (r -> end))
                 (end  : (r -> end)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


For example:

;;;;;;
> (my-automaton '(c a d r))
I see c
I see d
#t
;;;;;;



Best of wishes!