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