Let over lambda and source location information

Take the following code:

(require racket/match)

(define-syntax-rule (methods* [(method-name method-args ...) body ...] ...
                              fallback)
  (let ((method-name
         (lambda (method-args ...)
           body ...)) ...)
    (define all-methods (list (cons 'method-name method-name) ...))
    (define method-dispatch
      (make-keyword-procedure
       (lambda (kw-args kw-vals method . args)
         (match (assq method all-methods)
           [(cons _name found-method)
            found-method
            #;(keyword-apply found-method kw-args kw-vals args)]
           [#f
            (keyword-apply fallback kw-args kw-vals method args)]))))
    method-dispatch))

(define no-such-method
  (make-keyword-procedure
   (lambda (kw-vals kw-args method . args)
     (error "No such method" method))))

(define-syntax-rule (methods method-defns ...)
  (methods* method-defns ... no-such-method))

This is kind of a kluge, I know. But you get the idea. Let over
lambda, because we're going to be reusing these procedures over and over
again across multiple calls.

Now let's say I instantiate this like:

  (define my-methods
    (methods
     [(double x)
      (* x x)]))
> my-methods
#<procedure:...tor-lib/methods.rkt:130:7>

That's the line where method-dispatch is defined, inside the macro.
But what I really want is for the annotation on the procedure to be
where my-methods is defined.... not pointing back inside the macro.

I have no idea how to do this. Thoughts?

4 Likes

In the macro template you have:

(lambda (kw-args kw-vals method . args) ...)

The default source location information thus points to the definition inside the macro.
To get a new location one option is to use syntax/loc:

(syntax/loc #'loc-stx    
  (lambda (kw-args kw-vals method . args) ...))

where loc-stx is a syntax object whose source location is the location, you want to
give to the lambda expression.

In your macro that location comes from the application of method. That means method needs to send the location along to method*. One of way doing so is shown below.

#lang racket
(require racket/match
         (for-syntax syntax/parse))

(define-syntax (methods* stx)
  (syntax-parse stx
    [(methods* loc-stx
               [(method-name method-args ...) body ...] ...
               fallback)
     #`(let ((method-name
              (lambda (method-args ...)
                body ...)) ...)
         (define all-methods (list (cons 'method-name method-name) ...))
         (define method-dispatch
           (make-keyword-procedure
            #,(syntax/loc #'loc-stx       
                (lambda (kw-args kw-vals method . args)
                  (match (assq method all-methods)
                    [(cons _name found-method)
                     found-method
                     #;(keyword-apply found-method kw-args kw-vals args)]
                    [#f
                 (keyword-apply fallback kw-args kw-vals method args)])))))
         method-dispatch)]))
  
(define no-such-method
  (make-keyword-procedure
   (lambda (kw-vals kw-args method . args)
     (error "No such method" method))))

(define-syntax (methods stx)
  (syntax-parse stx
    [(_methods method-defns ...)
     #'(methods* stx method-defns ... no-such-method)]))

(define my-methods
  (methods
   [(double x)
    (* x x)]))

my-methods

If you want both mehod* and method to be available to the user, then adding an argument to method* might not be desirable. In that case, rename method* above to, say, do-method* and define two macros method and method* which both expands to do-method*.

4 Likes

This is great! Thanks!

@soegaard's code has a typo, I think? methods should look like this for the srcloc to propagate correctly:

(define-syntax (methods stx)
  (syntax-parse stx
    [(_methods method-defns ...)
     #`(methods* #,stx method-defns ... no-such-method)]))

FWIW, I gave a similar solution, along with another solution that uses syntax-local-name in the mailing list, which, with high probability, probably went to the spam folder.

2 Likes