[racket] Style or and/define

From: Richard Lawrence (richard.lawrence at berkeley.edu)
Date: Wed Jun 12 16:05:49 EDT 2013

I wrote a macro once to `flatten' this kind of idiom, because I was
writing code where I was doing a *lot* of this.  It lets you mix
let-style bindings with tests that throw an error if they fail.

Warning: there is almost certainly a better way to write it (it is among
the first `real' macros I wrote in Racket, and I haven't looked at it in
a long time), but maybe you could adapt it to do what you're looking
for.

(define-syntax assertive-let*
  ; let* that simplifies intermixing of assertions and bindings
  (syntax-rules (?)
    ; base case: sequentially evaluate body forms, as in a regular let
    [(assertive-let* () body ...)
     (begin body ...)]
    ; when head form only has two expressions, just introduce a binding 
    [(assertive-let* ([name expr] fs ...) body ...)
     (let ((name expr))
       (assertive-let* (fs ...) body ...))]
    ; when head form has three expressions beginning with "?", it's an 
    ; assertion: expr evaluates or an error with message msg is raised
    [(assertive-let* ([? expr msg] fs ...) body ...)
     (if (not expr) 
         (error msg)
         (assertive-let* (fs ...) body ...))]
    ; otherwise, a three-place head form simultaneously makes an 
    ; assertion and introduces a binding for the result of the assertion
    [(assertive-let* ([name expr msg] fs ...) body ...)
     (let ([name expr])
       (if (not name)
           ; TODO: there's probably something more sensible to do here
           ; than just throwing an error, e.g., return a default value?
           (error msg) 
           (assertive-let* (fs ...) body ...)))]))

Then the code you linked to becomes something like (untested):

(define/private (get-x-spot char-width)
   (assertive-let*
      ([? char-width "Non-false char-width is required"]
       [dc (get-dc) "Failed to get dc"]
       [style (or (send (get-style-list) find-named-style "Standard")
                  (send (get-style-list) find-named-style "Basic"))
               "Failed to get a style"]
       [fnt  (send style get-font)])
     (define-values (xw _1 _2 _3) (send dc get-text-extent "x" fnt))
     (+ left-padding (* xw char-width))))

Though note that this code will now raise errors instead of returning #f
when one of the earlier bindings fails.

Hope that's helpful!

-- 
Best,
Richard


Posted on the users mailing list.