[racket] a little macro exercise

This looks a lot like Carl's (and my modification of it.)

Jay

On Sat, Oct 9, 2010 at 5:46 PM, David Herman <dherman at ccs.neu.edu> wrote:
> 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
>
>



-- 
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