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
<https://docs.racket-lang.org/reference/procedures.html#%28def._%28%28lib._racket%2Fprivate%2Fbase..rkt%29._procedure-rename%29%29>
and syntax-local-name
<https://docs.racket-lang.org/reference/stxtrans.html#%28def._%28%28quote._~23~25kernel%29._syntax-local-name%29%29>
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>
On Mon, Nov 29, 2021 at 12:18 PM Christine Lemmer-Webber <
[email protected]> wrote:
> 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?
>
> --
> 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 [email protected].
> To view this discussion on the web visit
> https://groups.google.com/d/msgid/racket-users/87sfveu34u.fsf%40dustycloud.org
> .
>
--
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 [email protected].
To view this discussion on the web visit
https://groups.google.com/d/msgid/racket-users/CADcuegsTy9T%3Drkxcmg99qdPPSUaUbP%3D%3Duz8wFu-aS4OgEG4wQg%40mail.gmail.com.
