[plt-scheme] Creating new syntax for decision tables

> (define-syntax table
>   (syntax-rules (:)
>     [(table (e : c1 c2 ...) ...)
>      (or (and (clause-transform c1 e) ...)
>          (table (e : c2 ...) ...))]
>     [(table (e :) ...)
>      #f]
>     [(table (e1 : c1 c2 ...) (e2 :))
>      (error "Table mismatch for rows"
>             (quote e1) 'and (quote e2))]
>     [(table (e1 :) (e2 : c1 c2 ...))
>      (error "Table mismatch for rows"
>             (quote e1) 'and (quote e2))]))

> 1. If I want to prevent the expressesions on the left side of the colons
>    from being evaluated more than once, what is the best way to do this?
>    My initial thought it to make another macro which passes those
>    expressions into a function call so that they are evaluated just
>    once.


Hi Andrew,

One way to do this is to use LET.  Unfortunately, I'm not so familiar with 
writing things with syntax-rules, but here's a version that uses 
syntax-case.  The idea is to generate a bunch of temporary names, one for 
each e, and then use the let-ed values in the table's case analysis 
instead:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module example mzscheme
   (provide table)

   (define-syntax (table stx)
     (syntax-case stx (:)
       [(_ (e : c1 c2 ...) ...)
        (with-syntax ([(ev ...)
                       (generate-temporaries (syntax (e ...)))])
          (syntax/loc stx
            (let ([ev e] ...)
              (table-internal (ev : c1 c2 ...) ...))))]
       [(_ (e :) ...)
        (syntax/loc stx #f)]
       [(_ (e1 : c1 c2 ...) (e2 :))
        (error "Table mismatch for rows"
               (quote e1) 'and (quote e2))]
       [(_ (e1 :) (e2 : c1 c2 ...))
        (error "Table mismatch for rows"
               (quote e1) 'and (quote e2))]))


   (define-syntax table-internal
     (syntax-rules (:)
       [(_ (e : c1 c2 ...) ...)
        (or (and (clause-transform c1 e) ...)
            (table-internal (e : c2 ...) ...))]
       [(_ (e :) ...)
        #f]
       [(_ (e1 : c1 c2 ...) (e2 :))
        (error "Table mismatch for rows"
               (quote e1) 'and (quote e2))]
       [(_ (e1 :) (e2 : c1 c2 ...))
        (error "Table mismatch for rows"
               (quote e1) 'and (quote e2))]))

   (define-syntax clause-transform
     (syntax-rules (T F *)
       [(clause-transform T e) e]
       [(clause-transform F e) (not e)]
       [(clause-transform * e) #t]
       [(clause-transform other e)
        (error "Unknown flag: " (quote other))])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

This way, the TABLE-INTERNAL macro only deals with simple values.


Unfortunately, although this avoids duplicate evaluation, it still 
evaluates all the values of the E's, even if we might not need them.

;;;;;;;;;;;;;;;;;;;;;;;;;;;
> (define-values (f g h) (values (lambda () #t)
                                  (lambda () #t)
                                  (lambda () #t)))
> (require (lib "trace.ss"))
> (trace f g h)
(f g h)
> (table ((f) : * *)
          ((g) : T T)
          ((h) : F T))
|(f)
|#t
|(g)
|#t
|(h)
|#t
#t
;;;;;;;;;;;;;;;;;;;;;;;;;;;



Another similar approach might be to do what you're thinking, building a 
function that remembers what it returns, so that we avoid evaluation 
unless absolutely necessary.

Thankfully, Dave Herman did most of the hard work in his memoize package:

     http://planet.plt-scheme.org/#memoize.plt

We can take advantage of memoize's MEMO-LAMBDA, and build a corresponding 
thunk for each E.

So the code above for the public-facing table macro can turn into:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(module example mzscheme
   (provide table)
   (require (planet "memoize.ss" ("dherman" "memoize.plt" 2 1)))

   (define-syntax (table stx)
     (syntax-case stx (:)
       [(_ (e : c1 c2 ...) ...)
        (with-syntax ([(e-thunk ...)
                       (generate-temporaries (syntax (e ...)))])
          (syntax/loc stx
            (let ([e-thunk (memo-lambda () e)] ...)
              (table-internal (e-thunk : c1 c2 ...) ...))))]
       [(_ (e :) ...)
        (syntax/loc stx #f)]
       [(_ (e1 : c1 c2 ...) (e2 :))
        (error "Table mismatch for rows"
               (quote e1) 'and (quote e2))]
       [(_ (e1 :) (e2 : c1 c2 ...))
        (error "Table mismatch for rows"
               (quote e1) 'and (quote e2))]))


   (define-syntax table-internal
     (syntax-rules (:)
       [(_ (e-thunk : c1 c2 ...) ...)
        (or (and (clause-transform c1 e-thunk) ...)
            (table-internal (e-thunk : c2 ...) ...))]
       [(_ (e-thunk :) ...)
        #f]
       [(_ (e1-thunk : c1 c2 ...) (e2-thunk :))
        (error "Table mismatch for rows"
               (quote e1-thunk) 'and (quote e2-thunk))]
       [(_ (e1-thunk :) (e2-thunk : c1 c2 ...))
        (error "Table mismatch for rows"
               (quote e1-thunk) 'and (quote e2-thunk))]))

   (define-syntax clause-transform
     (syntax-rules (T F *)
       [(clause-transform T e-thunk) (e-thunk)]
       [(clause-transform F e-thunk) (not (e-thunk))]
       [(clause-transform * e-thunk) #t]
       [(clause-transform other e-thunk)
        (error "Unknown flag: " (quote other))])))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



And we can see that this works out:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
> (define-values (f g h) (values (lambda () #t)
                                  (lambda () #t)
                                  (lambda () #t)))
> (trace f g h)
(f g h)
> (table ((f) : * *)
          ((g) : T T)
          ((h) : F T))
|(g)
|#t
|(h)
|#t
#t
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Hurrah, it's not evaluating the f function anymore.


Best of wishes!