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.

"define-syntax" and "syntax-rules" in Scheme

Scheme has a macro mechanism which allow us to extend the Scheme language syntax. The description in Revised5 Report on the Algorithmic Language Scheme is precise. But the description has a mathematical flavor.

I refer to the book The Scheme Programming Language. It uses the following example to explain "define-syntax" and "syntax-rules". The following code is to define let. let is defined as (let <bindings> <body>) in Revised5 Report on the Algorithmic Language Scheme.

(define-syntax let
  (syntax-rules ()
    ((_ ((x v) ...) e1 e2 ...)
     ((lambda (x ...) e1 e2 ...) v ...))))

I still find the description hard for me to understand because I am very new to Scheme. After some time of struggling, I find the following way to understand it. (let <bindings> <body>) is just like a function invocation. bindings create a local binding scope. In some sense, it binds formal parameters to actual parameters. Take (let ((x 1) (y 2)) (+ x y)) as an example, x is bound to 1 and is bound to 2. body is just like the body of an function. (+ x y) will produce 3.

Back to the "define-syntax" example, we see that ((lambda (x ...) e1 e2 ...) v ...) define what we have described as function invocation. For (_ ((x v) ...) e1 e2 ...), we can see that (x v) indicate a binding. ((x v) ...) indicates any number of bindings. e1 indicates a expression in the body. e1 e2 ... indicates all the expressions in the body.