This looks a lot like Carl's (and my modification of it.) Jay
On Sat, Oct 9, 2010 at 5:46 PM, David Herman <dher...@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.mccar...@gmail.com> wrote: >>> You got me >>> >>> Sent from my iPhone >>> >>> On Oct 8, 2010, at 10:33 PM, Eli Barzilay <e...@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 <j...@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 <j...@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
