1#lang racket/base 2(require "../syntax/syntax.rkt") 3 4(provide rename-transformer? 5 prop:rename-transformer 6 make-rename-transformer 7 rename-transformer-target) 8 9(define-values (prop:rename-transformer rename-transformer? rename-transformer-value) 10 (make-struct-type-property 'rename-transformer 11 (lambda (v info) 12 (unless (or (exact-nonnegative-integer? v) 13 (identifier? v) 14 (and (procedure? v) 15 (procedure-arity-includes? v 1))) 16 (raise-argument-error 17 'guard-for-prop:rename-transformer 18 (string-append "(or/c exact-nonnegative-integer?\n" 19 " identifier?\n" 20 " (procedure-arity-includes? proc 1))") 21 v)) 22 (when (exact-nonnegative-integer? v) 23 (unless (v . <= . (list-ref info 1)) 24 (raise-arguments-error 'guard-for-prop:rename-transformer 25 "field index >= initialized-field count for structure type" 26 "field index" v 27 "initialized-field count" (list-ref info 1))) 28 (unless (member v (list-ref info 5)) 29 (raise-arguments-error 'guard-for-prop:rename-transformer 30 "field index not declared immutable" 31 "field index" v))) 32 (define ref (list-ref info 3)) 33 (cond 34 [(identifier? v) (lambda (t) v)] 35 [(integer? v) 36 (lambda (t) 37 (define val (ref t v)) 38 (if (identifier? val) 39 val 40 (datum->syntax #f '?)))] 41 [else (lambda (t) 42 (define id (call-with-continuation-barrier 43 (lambda () 44 (v t)))) 45 (unless (identifier? id) 46 (raise-arguments-error 'prop:rename-transformer 47 "contract violation for given value; expected an identifier" 48 "given" id)) 49 id)])))) 50 51(struct id-rename-transformer (id) 52 #:property prop:rename-transformer 0 53 #:reflection-name 'rename-transformer) 54 55(define (make-rename-transformer id) 56 (unless (identifier? id) 57 (raise-argument-error 'make-rename-transformer "identifier?" id)) 58 (id-rename-transformer id)) 59 60(define (rename-transformer-target t) 61 ((rename-transformer-value t) t)) 62