Let over lambda and location information

[Christine Lemmer-Webber]

Take the following code:

#+BEGIN_SRC racket
(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))
#+END_SRC

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:

#+BEGIN_SRC racket
(define my-methods
(methods
[(double x)
(* x x)]))
#+END_SRC

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

[Christine Lemmer-Webber]

Oops, just saw the discourse forum. Moved to:

https://racket.discourse.group/t/let-over-lambda-and-source-location-information/306

[Sorawee Porncharoenwase]

If you simply want the source location to be the macro call site, one approach is finding where the source location currently is (in this case, it’s the lambda inside make-keyword-procedure). Then, you simply need to thread syntax/loc through macros to put the source location there.

Here’s an example:

#lang racket

(require racket/match
         syntax/parse/define)

(define-syntax-parse-rule
  (methods*
   [(method-name method-args ...) body ...] ...
   fallback)

  #:with the-proc
  (syntax/loc this-syntax
    (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)])))

  (let ((method-name
         (lambda (method-args ...)
           body ...)) ...)
    (define all-methods (list (cons 'method-name method-name) ...))
    (define method-dispatch
      (make-keyword-procedure the-proc))
    method-dispatch))

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

(define-syntax-parse-rule (methods method-defns ...)
  #:with out
  (syntax/loc this-syntax
    (methods* method-defns ... no-such-method))
  out)

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

my-methods ;=> #<procedure:foo.rkt:42:2>

Also note that there’s procedure-rename and syntax-local-name which you might want to use instead:

#lang racket

(require racket/match
         syntax/parse/define)

(define-syntax-parse-rule
  (methods*
   [(method-name method-args ...) body ...] ...
   fallback)

  #:with the-name (syntax-local-name)

  (let ((method-name
         (lambda (method-args ...)
           body ...)) ...)
    (define all-methods (list (cons 'method-name method-name) ...))
    (define method-dispatch
      (procedure-rename
       (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)])))
       'the-name))
    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))

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

my-methods ;=> #<procedure:my-methods>

--
You received this message because you are subscribed to the Google Groups "Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email to racket-users...@googlegroups.com.
To view this discussion on the web visit https://groups.google.com/d/msgid/racket-users/87sfveu34u.fsf%40dustycloud.org.