190 lines
8.1 KiB
Racket
190 lines
8.1 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/contract
|
|
racket/format
|
|
racket/match
|
|
"syntax.rkt")
|
|
|
|
(provide how/c
|
|
->identifier
|
|
->identifier-resolved-binding-info)
|
|
|
|
;;; Creating identifiers from symbols or strings
|
|
|
|
;; A simplifying helper for commands that want to work both ways, and
|
|
;; accept a first "how" or "context" argument that is either
|
|
;; 'namespace or a path-string.
|
|
(define how/c (or/c 'namespace path-string?))
|
|
|
|
(define/contract (->identifier how v k)
|
|
(-> how/c (or/c symbol? string?) (-> syntax? any) any)
|
|
(match how
|
|
['namespace (->identifier/namespace v k)]
|
|
[(? (and string? path-string?) p) (->identifier/expansion p v k)]))
|
|
|
|
(define/contract (->identifier/namespace v k)
|
|
(-> (or/c symbol? string?) (-> identifier? any/c) any/c)
|
|
(define sym->id namespace-symbol->identifier)
|
|
(k (cond [(string? v) (sym->id (string->symbol v))]
|
|
[(symbol? v) (sym->id v)])))
|
|
|
|
;; We use path-str to get expanded module syntax from the cache via
|
|
;; path->existing-expanded-syntax, and use the 'module-body-context
|
|
;; syntax property -- starting in Racket 6.5 -- which can be used as
|
|
;; lexical context to make an identifier. This lets identifier-binding
|
|
;; work for identifiers as if they were in that body's lexical context
|
|
;; -- including imported identifiers that aren't actually used as
|
|
;; bindings in the module body.
|
|
(define/contract (->identifier/expansion path-str v k)
|
|
(-> path-string?
|
|
(or/c symbol? string?)
|
|
(-> identifier? any/c)
|
|
any/c)
|
|
(path->existing-expanded-syntax
|
|
path-str
|
|
(λ (stx)
|
|
(define (sym->id v)
|
|
(expanded-module+symbol->identifier path-str stx v))
|
|
(k (cond [(string? v) (sym->id (string->symbol v))]
|
|
[(symbol? v) (sym->id v)])))))
|
|
|
|
(define/contract (expanded-module+symbol->identifier path-str exp-mod-stx sym)
|
|
(-> path-string? syntax? symbol? identifier?)
|
|
;; For imported bindings, this creates syntax where
|
|
;; identifier-binding will report a module-path-index that can be
|
|
;; resolved to a path that exists. Great!
|
|
;;
|
|
;; For module bindings, identifier-binding will say that the binding
|
|
;; exists. Good! But. Until a module declaration is evaluated, the
|
|
;; module has no name. As a result, the module-path-index is
|
|
;; reported as #<module-path-index='|expanded module|>. That would
|
|
;; resolve to <path:"/path/to/expanded module.rkt"> -- wrong.
|
|
;;
|
|
;; Work-around: Let's record the path in the identifier's
|
|
;; syntax-source. Doing so won't change what identifier-binding
|
|
;; reports, but it means mpi->path can handle such a module path
|
|
;; index by instead using the path from syntax-source.
|
|
(datum->syntax (syntax-property exp-mod-stx 'module-body-context)
|
|
sym
|
|
(list (string->path path-str) #f #f #f #f)))
|
|
|
|
|
|
;;; Massaging values returned by identifier-binding
|
|
|
|
;; A composition that does the right thing, including when making an
|
|
;; identifier that is a module binding.
|
|
(define (->identifier-resolved-binding-info how v k)
|
|
(->identifier how v
|
|
(λ (id)
|
|
(k (resolve-identifier-binding-info
|
|
id
|
|
(identifier-binding id))))))
|
|
|
|
;; Given an identifier and the result from identifier-binding, returns
|
|
;; a subset of the information, where the module path indexes are
|
|
;; resolved to actual paths, and where the 'lexical value is treated
|
|
;; as #f.
|
|
(define/contract (resolve-identifier-binding-info id binding-info)
|
|
(-> identifier?
|
|
(or/c 'lexical
|
|
#f
|
|
(list/c module-path-index?
|
|
symbol?
|
|
module-path-index?
|
|
symbol?
|
|
exact-nonnegative-integer?
|
|
(or/c exact-integer? #f)
|
|
(or/c exact-integer? #f))
|
|
(list/c symbol?))
|
|
(or/c #f
|
|
(listof (cons/c symbol?
|
|
(or/c 'kernel
|
|
(cons/c path-string? (listof symbol?)))))))
|
|
(match binding-info
|
|
[(list source-mpi source-id
|
|
nominal-source-mpi nominal-source-id
|
|
source-phase
|
|
import-phase
|
|
nominal-export-phase)
|
|
(list (cons source-id (id+mpi->path id source-mpi))
|
|
(cons nominal-source-id (id+mpi->path id nominal-source-mpi)))]
|
|
[_ #f]))
|
|
|
|
(define/contract (id+mpi->path id mpi)
|
|
(-> identifier?
|
|
module-path-index?
|
|
(or/c 'kernel
|
|
(cons/c path-string? (listof symbol?))))
|
|
(cond [;; We could check below for the interned -- or not in older
|
|
;; Rackets -- symbol '|expanded module|. That seems smelly.
|
|
;; Instead if we're a "self" module, and if the identifier
|
|
;; has a location -- probably supplied above by our
|
|
;; expanded-module+symbol->identifier -- use that source.
|
|
(and (self-module? mpi)
|
|
(syntax-source id))
|
|
(list (syntax-source id))]
|
|
[else
|
|
(match (resolved-module-path-name
|
|
(module-path-index-resolve mpi))
|
|
[(? hash-percent-symbol) 'kernel]
|
|
[(? path-string? path) (list path)]
|
|
[(? symbol? sym)
|
|
(list (build-path (current-load-relative-directory)
|
|
(~a sym ".rkt")))]
|
|
[(list (? path-string? path) (? symbol? subs) ...)
|
|
(list* path subs)]
|
|
;; I've seen this odd case occur only when running
|
|
;; test/find.rkt. The module path index is
|
|
;; #<module-path-index:(submod "." m) + '|expanded
|
|
;; module|>, and resolving that is (find-examples m) when
|
|
;; it should be '(#</path/to/find-example.rkt> m).
|
|
[(list (? symbol?) (? symbol? subs) ...)
|
|
(list* (syntax-source id) subs)])]))
|
|
|
|
(define (self-module? mpi)
|
|
(define-values (a b) (module-path-index-split mpi))
|
|
(and (not a) (not b)))
|
|
|
|
(define (hash-percent-symbol v)
|
|
(and (symbol? v)
|
|
(regexp-match? #px"^#%" (symbol->string v))))
|
|
|
|
(module+ test
|
|
(require rackunit
|
|
"syntax.rkt")
|
|
;; Check something that is in the namespace resulting from
|
|
;; module->namespace on, say, this source file.
|
|
(parameterize ([current-namespace (module->namespace (syntax-source #'here))])
|
|
(check-not-false (->identifier-resolved-binding-info 'namespace 'match values))
|
|
(check-not-false (->identifier-resolved-binding-info 'namespace "match" values)))
|
|
|
|
;; Check something that is not in the current namespace, but is an
|
|
;; identifier in the lexical context of an expanded module form --
|
|
;; including imported identifiers -- from the expanded syntax
|
|
;; cache.
|
|
(define path-str "/path/to/foobar.rkt")
|
|
(define code-str (~a '(module foobar racket/base
|
|
(require net/url racket/set)
|
|
(let ([a-lexical-binding 42])
|
|
a-lexical-binding)
|
|
(define a-module-binding 42)
|
|
a-module-binding)))
|
|
;; Get the expanded syntax in our cache
|
|
(string->expanded-syntax path-str code-str void)
|
|
;; Simple imported binding
|
|
(check-not-false (->identifier-resolved-binding-info path-str 'set? values))
|
|
(check-not-false (->identifier-resolved-binding-info path-str "set?" values))
|
|
;; Import where renaming/contracting is involved
|
|
(check-not-false (->identifier-resolved-binding-info path-str 'get-pure-port values))
|
|
(check-not-false (->identifier-resolved-binding-info path-str "get-pure-port" values))
|
|
;; Get a module binding
|
|
(check-equal? (->identifier-resolved-binding-info path-str "a-module-binding" values)
|
|
(let ([path (string->path path-str)])
|
|
`((a-module-binding ,path)
|
|
(a-module-binding ,path))))
|
|
;; Get a lexical binding: Should return false
|
|
(check-false (->identifier-resolved-binding-info path-str "a-lexical-binding" values))
|
|
;; Get something that's not a binding in at all: Should return false
|
|
(check-false (->identifier-resolved-binding-info path-str "ASDFASDFDS" values))
|
|
;; Get whatever in some file not in expanded syntax cache: Should return false
|
|
(check-false (->identifier-resolved-binding-info "not/yet/expanded.rkt" "whatever" values)))
|