Compile-time dispatch based on 'type'

Questions & Answers
4

Ah, yes, hence my question about the locality.

This is ugly, but the idea might be fruitful, i.e., using a syntax-parameter or similar contrivance to simulate the annotations.

Which is not to say that attributes might not work, but my brain isn't braining that way, right now.

#lang racket

(require
  racket/stxparam
  (for-syntax
   syntax/parse syntax/parse/class/struct-id racket/hash))

(struct A (a b))
(struct B (b))

(define-syntax-parameter ref-types (hash))

(begin-for-syntax
  (define (the-types) (syntax-parameter-value #'ref-types))
  (define (known? id) (hash-has-key? (the-types) id))
  
  (define-syntax-class ref-expr
    (pattern [x type]
      #:do [(define v (syntax->datum #'x))]
      
      #:fail-when (not (known? v))
      (format "incorrect type syntax, unexpected id: ~a" v)
      
      #:do [(define T (syntax->datum #'type))
            (define ref-pattern (hash-ref (the-types) v))
            (define the-type (car  ref-pattern))
            (define the-ref  (cadr ref-pattern))]
      
      #:fail-when (not (eq? the-type T))
      (format "incorrect type syntax, expected type: ~a" T)
      
      #:with ref #`(#,the-ref x))))

(define-syntax (with-refs stx)
  (syntax-parse stx
    [(_ ([which (type:struct-id get)] ...)
        body ...)
     #:do [(define instances  (syntax->datum #'(get ...)))
           (define accessors  (syntax->datum #'((type.accessor-id ...) ...)))
           (define valid-get? (andmap (lambda (g G) (member g G)) instances accessors))]
     #:when valid-get?
     #`(syntax-parameterize ([ref-types (#:combine/key (lambda (k a b) b)
                                         . hash-union .
                                         #,(the-types) (hash (~@ 'which '(type get)) ...))])
         body ...)]))

(define-syntax (ref stx)
  (syntax-parse stx
    [(_ x:ref-expr) #'x.ref]))

(with-refs ([x (A A-a)]
            [y (A A-b)])
  (list
   (let ([x (A 'i 'j)])
     (list
      (ref [x A])
      (with-refs ([x (B B-b)])
        (let ([x (B 'bb)]) (ref [x B])))))

   (let ([y (A 'm 'n)]) (ref [y A]))))

;=> '((i bb) n)

Thanks to @shawnw for showing me the struct-id syntax class.

Maybe have a look at his with-slots, now that I think about it...

Edit: this way, you can have shadowing of ref patterns, but I am just messing around.