[racket] Onlisp's condlet macro in Racket

From: Matthias Felleisen (matthias at ccs.neu.edu)
Date: Wed Jan 2 11:33:00 EST 2013

Sean, it took me a while to figure out condlet but here is how a Racketeer would write this (questionable) macro: 

(define-syntax (condlet stx)
  (syntax-case stx ()
    [(condlet ((c (x e) ...) ...) body ...)
     #'(cond
         [c (let* ((x '()) ... ...)
              (let ((x e) ...)
                body ...))] 
          ...)]))

As Stephan points out, a let* suffices here because it simply doesn't matter because it simply doesn't matter which x binding body ... sees. 

For your information, you can also write 

(define-syntax (condlet stx)
  (syntax-case stx ()
    [(condlet ((c (x e) ...) ...) body ...)
     (let* ((vars (remove-duplicates #'(x ... ...)))
            (nils (map (lambda (c) #''()) vars)))
       #`(cond
           [c ((lambda #,vars
                  (let ((x e) ...)
                    body ...))
                #, at nils)]
           ...))]))

(define-for-syntax (remove-duplicates vars)
  (let loop ((vars (syntax->list vars)) (seen '()))
    (cond
      [(null? vars) seen]
      [(memf (lambda (s) (free-identifier=? (car vars) s)) seen) (loop (cdr vars) seen)]
      [else (loop (cdr vars) (cons (car vars) seen))])))

The define-for-syntax form introduces functions usable during the syntax phase. That keeps your syntax definitions small. See style guide. 

Here are the tests I ran 

(module+ test
  (require rackunit)
  (define (princ s)
    (displayln s)
    s))

(module+ test 
  
  (check-equal? 
   (let ((x 1))
     (condlet (((= x 2) (x (princ 'a)) (y (princ 'b)))
               ((= x 1) (y (princ 'c)) (x (princ 'd)))
               (else (x (princ 'e)) (z (princ 'f))))
              (list x y z)))
   (list 'd 'c '())))


-- Matthias







On Jan 1, 2013, at 5:59 PM, Sean Kanaley wrote:

> While I've ultimately succeeded in having it return the correct output for a sample input, I'm not positive it's correct in general and I am positive it's written poorly, as I don't fully understand both syntax-case and syntax objects vs. datums.  If someone could look it over and provide a more canonical version, I would be grateful.
> 
> Here's how the macro works:
> 
> > (condlet (((= 1 2) (x (princ ’a)) (y (princ ’b)))
>             ((= 1 1) (y (princ ’c)) (x (princ ’d)))
>             (t (x (princ ’e)) (z (princ ’f))))
>     (list x y z))
> CD
> (D C NIL)
> 
> Before I post the horrible racket code, I will explain the problems I'm having with macros in general:
> 
> Problem 1, separate phases:  I have a remove-duplicates-by function that would be great to have globally, but it seemingly must be written locally.
> 
> Problem 2: You can't use a pattern variable outside of a pattern, so you have to syntax-ify it with #', but then you can't access the associated s-exp without removing the syntax.  The way to bind things to null by default is to get every id and output the obvious let statement, except ids might be repeated so you have to remove duplicates (enter problem 1).  It's remove-duplicates-BY because the removal happens by syntax->datum'ing each identifier-syntax-thing since it can't appear outside of a pattern.
> 
> Problem 2: How to remove a portion of the macro code into a separate transformer function?  It's kind of annoying having a whole block of code relegated to cleaning up the duplicate ids inside of the let it expands into.  That would ideally be written "let #,(remove-dups #'(c cs...))" or similar...some kind of sub-macro to handle just getting ids.  I thought that's what let-syntax or nested define syntaxes were for but I get phase errors or preposterous, very dark errors like "lambda not bound".  Suddenly I prefer Haskell's a is not an infinitely existential StateT (Bool -> IO (StateT (Cont String) (Cont String) ())) Maybe (a1,a1'), in subexpression f . g.  Oh, f <$> g.  everything checks out now!  Thanks, ghci, and by the way go **** yourself you stupid Cont.
> 
> Anywayyyyy here is my code that works for the above example at least:
> 
> (define-syntax (condlet s)
>   (let ((remove-duplicates-by
>          (λ (f l) (let R ((l l))
>                     (if (null? l)
>                         null
>                         (cons (car l) (R (remove* (list (car l))
>                                                   (cdr l)
>                                                   (λ (a b)
>                                                     (eq? (f a) (f b)))))))))))
>     (syntax-case s ()
>       ((_ (c) body ...)
>        (syntax-case #'c (else)
>          ((else binds ...)
>           #'(let (binds ...) body ...))
>          ((t binds ...)
>           #'(if t (let (binds ...) body ...) (void)))))
>       ((_ (c cs ...) body ...)
>        (syntax-case #'c ()
>          ((t binds ...)
>           #`(let #,(syntax-case #'(c cs ...) ()
>                      (((_ (i _) ...) ...)
>                       (map (λ (i) #`(#,i null))
>                            (remove-duplicates-by
>                             syntax->datum
>                             (syntax->list #'(i ... ...))))))
>               (if t
>                   (let (binds ...) body ...)
>                   (condlet (cs ...) body ...)))))))))
> 
> Any help is appreciated.
> ____________________
>  Racket Users list:
>  http://lists.racket-lang.org/users

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.racket-lang.org/users/archive/attachments/20130102/7e04770d/attachment.html>

Posted on the users mailing list.