Building DSL with Scheme

I have listened a talk made by Shriram Krishnamurthi. It is called The Swine Before Perl . The talk is about using scheme to do heavy lifting which other languages can't handle. It is a great talk. It shows me the real amazing strength of Scheme programming language. Shriram centers his talk around an example of automaton. The Scheme source code is based on the old version of PLT Scheme. As a result, the source code can't run against the current implementation. I have made a little change to the source code. I post it here for reference.

The following source code is tested in DrScheme, version 4.1.4.
The first version of automaton.

#lang slideshow
(define b-machine-states
  '((init (c more))
    (more (a more)
          (d more)
          (r end))
    (end (r end))))

(define (b-machine stream)
  (letrec ([walker (lambda (state stream)
                     (or (empty? stream)
                         (let ([transitions
                                 (cdr (assv state b-machine-states))])
                           (let ([1st (first stream)])
                             (let ([new-state (assv 1st transitions)])
                               (if new-state
                                 (walker (cadr new-state) (rest stream))
                                 false))))))])
    (walker 'init stream)))

(b-machine '(c a r))
(b-machine '(c a d r))
(b-machine '(c a x))

The goto version of automaton.

#lang scheme
(define b-machine
  (letrec ([init
             (lambda (stream)
               (or (empty? stream)
                   (case (first stream)
                     [(c) (more (rest stream))]
                     [else false])))]
           [more
             (lambda (stream)
               (or (empty? stream)
                   (case (first stream)
                     [(a) (more (rest stream))]
                     [(d) (more (rest stream))]
                     [(r) (end (rest stream))]
                     [else false])))]
           [end
             (lambda (stream)
               (or (empty? stream)
                   (case (first stream)
                     [(r) (end (rest stream))]
                     [else false])))])
    init))

(b-machine '(c a r))
(b-machine '(c a d r))
(b-machine '(c a x))

The second version of automaton.

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

(define b-machine 
  (automaton init
             (init : ((c) -> more))
             (more : ((a) -> more)
                     ((d) -> more)
                     ((r) -> end))
             (end  : ((r) -> end))))



(b-machine '(c a r))
(b-machine '(c a d r))
(b-machine '(c a x))

The following code is really an elegant DSL for automaon.

(automaton init
     (init : ((c) -> more))
     (more : ((a) -> more)
             ((d) -> more)
             ((r) -> end))
     (end  : ((r) -> end)))

I have also implemented the first and goto version of automaton in Ruby.
The first version of automaton in Ruby

$b_machine_states = {
  "init" => {"c" => "more"},
  "more" => {"a" => "more",
             "d" => "more",
             "r" => "end"},
  "end" => {"r" => "end"}}

def walker(state, stream)
  if stream.empty?
    return true
  end
  first = stream[0]
  transitions = $b_machine_states[state]
  new_state = transitions[first]
  if new_state == nil
    return false
  else
    rest = stream[1, stream.length()]
    return walker(new_state, rest)
  end
end

def b_machine(stream)
  walker("init", stream)
end

print b_machine("car") , "\n"
print b_machine("cadr") , "\n"
print b_machine("cax") , "\n"

The goto version of automaton in Ruby

class Automaton
  
  def accept(stream)
    return init(stream)
  end

  private
  def init(stream)
    if stream.empty?
      return true
    end
    first = stream[0]
    case first
    when "c"
      return more(rest(stream))
    else
      false
    end
  end

  def more(stream)
    if stream.empty?
      return true
    end
    first = stream[0]
    case first
    when "a"
      return more(rest(stream))
    when "d"
      return more(rest(stream))
    when "r"
      return terminate(rest(stream))
    else
      return false
    end
  end

  def terminate(stream)
    if stream.empty?
      return true
    end
    first = stream[0]
    case first
    when "r"
      return terminate(rest(stream))
    else
      return false
    end
  end

  def rest(stream)
    return stream[1, stream.length()]
  end
end

auto = Automaton.new()
print auto.accept("car") , "\n"
print auto.accept("cadr") , "\n"
print auto.accept("cax"), "\n"

For the second version of automaton, I can't find a way to implement it in Ruby because Ruby does not have a macro system similar to Scheme. I am happy to know if anyone has a solution.