I'm trying to move a runtime dispatch to compile time for efficiency reasons.
In the runtime version, I have two 'types', A and B, and a procedure ref-proc that behaves differently depending on the 'type':
#lang racket
(struct A (a))
(struct B (b))
(define (ref-proc x)
(cond [(A? x) (A-a x)]
[(B? x) (B-b x)]
[else (error "not implemented")]))
;; Examples:
(let ([x (A 'aaa)])
(ref-proc x)) ; 'aaa
(let ([x (B 'bbb)])
(ref-proc x)) ; 'bbb
Easy enough. Now, in the compile-time version, I'm happy to annotate x somehow such that ref can use this information to know how to dispatch. Perhaps something that would look like this:
(let ([x (A 'aaa)])
(with-AorB [x A] ; annotate `x` being of 'type' `A`
(ref x))) ; compile-time dispatch to `A-a`
(let ([x (B 'bbb)])
(with-AorB [x B] ; annotate `x` being of 'type' `B`
(ref x))) ; compile-time dispatch to `B-b`
I've tried to use syntax-property, but I don't know what I'm doing:
(define-syntax (with-AorB stx)
(syntax-parse stx
[(_ [x:id aorb:id] body ...)
(with-syntax ([x (syntax-property #'x 'AorB (syntax-e #'aorb))])
#'(begin body ...))]))
(define-syntax (ref stx)
(syntax-parse stx
[(_ x)
(begin
(define prop (syntax-property #'x 'AorB))
(writeln prop)
(case prop
[(A) #'(A-a x)]
[(B) #'(B-b x)]
[else (raise-syntax-error 'ref (format "incorrect type: ~a" prop) #'x)]))]))
(let ([x (A 'aaa)])
(with-AorB [x A]
(ref x))) ; compile-time error "ref: incorrect type: #f in: x"
Not sure if this is the right approach. Any clue?
Hi, @Laurent.O.
How localized do the refs need to be? If we're using syntax-parse, perhaps one might use a syntax-class like so?
#lang racket
(require
(for-syntax
syntax/parse))
(struct A (a))
(struct B (b))
(begin-for-syntax
(define-syntax-class A/B
(pattern [x (~literal A)]
#:with ref #'(A-a x))
(pattern [x (~literal B)]
#:with ref #'(B-b x))
(pattern else
#:with ref #false
#:fail-when #true
(format "incorrect type syntax: ~a" (syntax->datum #'else)))))
(define-syntax (ref stx)
(syntax-parse stx
[(_ x:A/B) #'x.ref]))
(let ([x (A 'aaa)]) (ref [x A]))
(let ([x (B 'bbb)]) (ref [x B]))
;(let ([x (A 'aaa)]) (ref oops))
; =>
#|
ref: incorrect type syntax: oops
parsing context:
while parsing A/B in: oops
|#
However, I am not sure what this adds apart from different syntax to the accessor (i.e. I don't understand the interplay with the dispatch, per se).
Thanks, that's an interesting idea, but that means I need to annotate at every use of ref, which kinda defeats the purpose.
I would like to annotate once, then potentially have many ref (and perhaps other accessors to come) in the body of the annotated block.
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.
You still need to provide the 'type' to ref though, it seems?
Indeed.
I guess you could just throw that bit away? But I am starting to suspect I don't really understand the assignment.
#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-map (hash))
(begin-for-syntax
(define (the-refs) (syntax-parameter-value #'ref-map))
(define (known? id) (hash-has-key? (the-refs) id))
(define-syntax-class ref-expr
(pattern x:id
#:do [(define v (syntax->datum #'x))]
#:fail-when (not (known? v))
(format "incorrect type syntax, unexpected id: ~a" v)
#:with ref #`(#,(hash-ref (the-refs) v) x))))
(define-syntax (with-refs stx)
(syntax-parse stx
[(_ ([which (type:struct-id get)] ...)
body ...)
#:do [(define accessor* (syntax->datum #'(get ...)))
(define accessors (syntax->datum #'((type.accessor-id ...) ...)))]
#:when (andmap member accessor* accessors)
#`(syntax-parameterize ([ref-map (#:combine/key (lambda (k a b) b)
. hash-union .
#,(the-refs) (hash (~@ 'which 'get) ...))])
body ...)]))
(define-syntax (ref stx)
(syntax-parse stx
[(_ ex:ref-expr) #'ex.ref]))
(with-refs ([x (A A-a)] [y (A A-b)])
(list
(let ([x (A 'i 'j)])
(list
(ref x)
(with-refs ([x (B B-b)])
(let ([x (B 'bb)])
(ref x)))))
(let ([y (A 'm 'n)])
(ref y))))
;=> '((i bb) n)
Edit: my OCD was killing me about that lambda around the member 
.
1 Like
That's clearer now 
It's actually a pretty neat solution, thanks!
(FTR: requires Lexi Lambda's syntax-classes packages for the struct-id class)
1 Like
Still for the record, I suppose a better version would use the syntax-id/tables.
Hmm, I am inclined to agree, but I am not sure how to make it work.
I tried using a bound-id-table with the assumption that this would do the trick, but I obviously don't understand what it is doing, because it does not seem to match the identifiers as I would expect.
I shall try some more. In the meantime, this little extension allows one to elide the explicit type of the struct, and only refer to the accessor:
#lang racket
(require
racket/stxparam
(for-syntax
racket/syntax syntax/parse syntax/parse/class/struct-id
racket/hash))
(struct A (a b-max))
(struct B (b))
(define-syntax-parameter ref-map (hash))
(begin-for-syntax
(define (the-refs) (syntax-parameter-value #'ref-map))
(define (known? id) (hash-has-key? (the-refs) id))
(define-syntax-class ref-expr
(pattern x:id
#:do [(define u (syntax->datum #'x))]
#:fail-when (not (known? u))
(format "incorrect ref-expr syntax, unexpected id: ~a" u)
#:with ref #`(#,(hash-ref (the-refs) u) x)))
(define-syntax-class ref-decl
(pattern (type:struct-id get)
#:with gets (format-id #'type "~a-~a" #'type #'get)
#:do [(define accessor* (syntax->datum #'gets))
(define accessors (syntax->datum #'(type.accessor-id ...)))]
#:fail-when
(not (member accessor* accessors))
("unexpected accessor declaration in: ~a\nexpected one of: ~a"
. format . accessor* accessors)))
(define (union-refs new-refs)
(#:combine/key (lambda (k a b) b)
. hash-union .
(the-refs) new-refs)))
(define-syntax (with-refs stx)
(syntax-parse stx
[(_ ([which ex:ref-decl] ...)
body ...)
#'(syntax-parameterize ([ref-map (union-refs (hash (~@ 'which 'ex.gets) ...))])
body ...)]))
(define-syntax (ref stx)
(syntax-parse stx
[(_ ex:ref-expr) #'ex.ref]))
(with-refs ([x (A a)] [y (A b-max)])
(list
(let ([x (A 'i 'j)])
(list
(ref x)
(with-refs ([x (B b)])
(let ([x (B 'k)])
(ref x)))))
(let ([y (A 'm 'n)])
(ref y))))
;=> '((i k) n)
P.S. this was a fun diversion for the day. Kudos.
Edit: use regex, and then you have .+ problems 
1 Like