From 86ee9c50716f5c5209104a80b9d7b015f2f800b2 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Thu, 13 Aug 2015 10:10:41 -0600 Subject: [PATCH] signature-members: adjust element ids based on reference Make the resulting content ids compatible with binding and reference at a use site, as needed for the new macro expander. --- .../scribblings/reference/units.scrbl | 4 +++ pkgs/racket-test/tests/units/test-exptime.rkt | 36 +++++++++++++++++++ racket/collects/racket/unit-exptime.rkt | 12 ++++--- 3 files changed, 48 insertions(+), 4 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/units.scrbl b/pkgs/racket-doc/scribblings/reference/units.scrbl index 6f8da3ee96..8416733e4e 100644 --- a/pkgs/racket-doc/scribblings/reference/units.scrbl +++ b/pkgs/racket-doc/scribblings/reference/units.scrbl @@ -876,6 +876,10 @@ values: ] +Each of the result identifiers is given a lexical context that is +based on @racket[sig-identifier], so the names are suitable for +reference or binding in the context of @racket[sign-identifier]. + If @racket[sig-identifier] is not bound to a signature, then the @exnraise[exn:fail:syntax]. In that case, the given @racket[err-syntax] argument is used as the source of the error, where diff --git a/pkgs/racket-test/tests/units/test-exptime.rkt b/pkgs/racket-test/tests/units/test-exptime.rkt index db732446ac..98c6087f58 100644 --- a/pkgs/racket-test/tests/units/test-exptime.rkt +++ b/pkgs/racket-test/tests/units/test-exptime.rkt @@ -52,4 +52,40 @@ (test '((#f . one^)) (unit-dep-info one@ quote)) (test '((Four . four^)) (unit-dep-info two@ quote)) +(module m racket/base + (require racket/unit + (for-syntax racket/base)) + (provide x^ y^) + (define-signature x^ (x)) + (define-signature y^ (y + (define-syntaxes (get-y) (lambda (stx) #'y)) + (define-values (y2) 10)))) +(require 'm) + +;; based on code by Jay: +(define-syntax (as-s stx) + (syntax-case stx () + [(_ e ...) + (with-syntax ([([i-export e-export] ...) + (let-values ([(_1 ids _2 _3) (signature-members #'x^ stx)]) + (for/list ([i (in-list ids)]) + (list i (datum->syntax stx (syntax->datum i)))))] + [([i-import e-import] ...) + (let-values ([(_1 ids var-ids stx-ids) (signature-members #'y^ stx)]) + (for/list ([i (in-list (append ids var-ids stx-ids))]) + (list i (datum->syntax stx (syntax->datum i)))))]) + (syntax/loc stx + (unit (import y^) (export x^) + (define-syntax e-import (make-rename-transformer #'i-import)) + ... + e ... + (define i-export e-export) + ...)))])) +(define y 'y) +(define-values/invoke-unit + (as-s (define x (list y (get-y) y2))) + (import y^) + (export x^)) +(test '(y y 10) x) + (displayln "tests passed") diff --git a/racket/collects/racket/unit-exptime.rkt b/racket/collects/racket/unit-exptime.rkt index e86cf9a89c..7cd1b67b4e 100644 --- a/racket/collects/racket/unit-exptime.rkt +++ b/racket/collects/racket/unit-exptime.rkt @@ -21,13 +21,17 @@ (define (signature-members name err-stx) (parameterize ((error-syntax err-stx)) (let ([s (lookup-signature name)]) + (define intro + (make-relative-introducer name + (car (siginfo-names (signature-siginfo s))))) (values ;; extends: (and (pair? (cdr (siginfo-names (signature-siginfo s)))) - (cadr (siginfo-names (signature-siginfo s)))) + (intro (cadr (siginfo-names (signature-siginfo s))))) ;; vars - (apply list (signature-vars s)) + (map intro + (apply list (signature-vars s))) ;; defined vars - (apply list (apply append (map car (signature-val-defs s)))) + (map intro (apply list (apply append (map car (signature-val-defs s))))) ;; defined stxs - (apply list (apply append (map car (signature-stx-defs s)))))))) + (map intro (apply list (apply append (map car (signature-stx-defs s)))))))))