[racket] a little macro exercise

I thought about the "am I falling through?" approach you've been taking, but the problem is that it keeps having to recompute the same test. In C-like languages, one of the benefits of `switch' [1] is that fall-through is expected to either be a literal "execute the next instruction in the PC" or at least a jump to a fixed address. So I prefer an approach that sets up a basic-block-like structure, like so:

    +-------+
    | test1 |
    +-------+ ....> +------+
       .            | rhs1 |
       .            +------+
       v               .
    +-------+          .
    | test2 |          v
    +-------+ ....> +------+
       .            | rhs2 |
       .            +------+
       v               .
    +-------+          .
    | test3 |          v
    +-------+ ....> +------+
       .            | rhs3 |
       .            +------+
       .               .
       .               .

If each of these blocks is compiled as a local thunk, I'd expect a decent (not necessarily brilliant) Scheme compiler to be able to turn the function call at the end of each rhs_i block into a jump to a static address, and possibly even reorder the basic blocks to make some of them jump-less. With modern branch-prediction, the latter may be unnecessary.

With that, here's my solution:

#lang racket

(require racket/stxparam)

(define-syntax-parameter break
  (lambda (stx)
    (raise-syntax-error 'break "used outside of cas-cad-e case" stx)))

(define-syntax (cas-cad-e stx)
  (syntax-case stx ()
    [(_ disc)
     #'(void)]
    [(_ disc [lhs rhs ...] ... [last-lhs last-rhs ...])
     (let ([test-ids (generate-temporaries (syntax->list #'(lhs ...)))]
           [consequent-ids (generate-temporaries (syntax->list #'(lhs ...)))]
           [last-test-id (car (generate-temporaries (list #'last-lhs)))]
           [last-consequent-id (car (generate-temporaries (list #'last-lhs)))])
       (with-syntax ([(test ...) test-ids]
                     [(consequent ...) consequent-ids]
                     [last-test last-test-id]
                     [last-consequent last-consequent-id])
         (with-syntax ([(next-test ...) (append (cdr test-ids) (list last-test-id))]
                       [(next-consequent ...) (append (cdr consequent-ids) (list last-consequent-id))])
           (with-syntax ([test0 (if (null? test-ids) last-test-id (car test-ids))])
             #'(let ([disc-v disc])
                 (let/ec k
                   (syntax-parameterize ([break (syntax-rules ()
                                                  [(_ v)
                                                   (k v)])])
                     (define (test)
                       (case disc-v
                         [lhs (consequent)]
                         [else (next-test)]))
                     ...
                     (define (consequent)
                       rhs ...
                       (next-consequent))
                     ...
                     (define (last-test)
                       (case disc-v
                         [last-lhs (last-consequent)]))
                     (define (last-consequent)
                       last-rhs ...)
                     (test0))))))))]))

Dave

[1] Please do not construe this as tacit approval of the `switch' form. Ick.

On Oct 9, 2010, at 6:13 AM, Jay McCarthy wrote:

> I don't really like have the call-with-values and apply there, so
> here's another version. It makes the macro a bit longer with the
> additional case and has the pattern duplicated once, but it seems
> worth it:
> 
> (define-syntax cas-cad-e
>  (syntax-rules ()
>    [(_ e) (begin e (void))]
>    [(_ e [(n ...) code ...] ... [(n_l ...) code_l ...])
>     (let/ec esc
>       (syntax-parameterize
>        ([break (make-rename-transformer #'esc)])
>        (let* ([tmp e]
>               [earlier? #f]
>               [earlier?
>                (if (or earlier? (equal? tmp n) ...)
>                    (begin code ... #t)
>                    earlier?)]
>               ...)
>          (when (or earlier? (equal? tmp n_l) ...)
>            code_l ...))))]))
> 
> Regarding Shriram's bug. The only thing that occurs to me is that
> you'd want eqv? and a ' on the ns, to be more like case.
> 
> Jay
> 
> On Fri, Oct 8, 2010 at 10:39 PM, Jay McCarthy <jay.mccarthy at gmail.com> wrote:
>> You got me
>> 
>> Sent from my iPhone
>> 
>> On Oct 8, 2010, at 10:33 PM, Eli Barzilay <eli at barzilay.org> wrote:
>> 
>>> 8 minutes ago, Jay McCarthy wrote:
>>>> Alright, here's the version with no mutation:
>>> 
>>> (cas-cad-e 1 [(1) (values 1 2 3)])
>>> 
>>> In other words:
>>> 
>>> (define-syntax-rule (cas-cad-e e [(n ...) code ...] ...)
>>>  (let/ec esc
>>>    (syntax-parameterize ([break (make-rename-transformer #'esc)])
>>>      (let*-values ([(tmp) e]
>>>                    [(earlier? ret) (values #f (void))]
>>>                    [(earlier? ret)
>>>                     (if (or earlier? (equal? tmp n) ...)
>>>                       (values #t (call-with-values (lambda () code ...) list))
>>>                       (values earlier? ret))]
>>>                    ...)
>>>        (apply values ret)))))
>>> 
>>> --
>>>          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
>>>                    http://barzilay.org/                   Maze is Life!
>> 
> 
> 
> 
> -- 
> Jay McCarthy <jay at cs.byu.edu>
> Assistant Professor / Brigham Young University
> http://teammccarthy.org/jay
> 
> "The glory of God is Intelligence" - D&C 93
> _________________________________________________
>  For list-related administrative tasks:
>  http://lists.racket-lang.org/listinfo/users