Created
February 3, 2020 15:28
-
-
Save greghendershott/e94e4aee7cb3040f5332d0b0b80800e5 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang racket/base | |
(require racket/match | |
racket/path | |
racket/pretty | |
syntax/modread) | |
(define (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. The module-path-index is reported as | |
;; #<module-path-index='|expanded module|> -- i.e. the case where | |
;; module-path-split-index returns two #f values to mean a "self" | |
;; module. Given that alone, there is no way to resolve it to a an | |
;; existing path; you'll end up with something like | |
;; <path:"/path/to/expanded module.rkt"> regardless of the actual | |
;; path-str. | |
;; | |
;; I tried using syntax-binding-set here, but couldn't come up with | |
;; the correct incantation. All I can think to do: Give path-str in | |
;; the identifier's syntax location. Although that won't affect what | |
;; identifier-binding reports, it can help us later in mpi->path -- | |
;; for a "self" module we can use syntax-source as the path. | |
(datum->syntax (syntax-property exp-mod-stx 'module-body-context) | |
sym | |
(list path-str #f #f #f #f))) | |
(define (file->expanded-syntax path-str k) | |
(parameterize ([current-namespace (make-base-namespace)] | |
[current-load-relative-directory (path-only path-str)]) | |
(k | |
(expand | |
(with-module-reading-parameterization | |
(λ () | |
(with-input-from-file path-str | |
(λ () | |
(port-count-lines! (current-input-port)) | |
(match (read-syntax) | |
[(? eof-object?) #'""] | |
[stx stx]))))))))) | |
;; /tmp/example.rkt is simply: | |
;; | |
;; #lang racket/base | |
;; (require net/url) ;for some imported bindings | |
;; (define some-module-binding 42) | |
(define path-str "/tmp/example.rkt") | |
(file->expanded-syntax | |
path-str | |
(λ (exp-mod-stx) | |
(define (show v) | |
(pretty-print (identifier-binding v))) | |
;; Imported binding | |
(show | |
(expanded-module+symbol->identifier path-str exp-mod-stx | |
'get-pure-port)) | |
;; '(#<module-path-index:net/url> | |
;; provide/contract-id-get-pure-port.1 | |
;; #<module-path-index:net/url> | |
;; get-pure-port | |
;; 0 | |
;; 0 | |
;; 0) | |
;; Module binding | |
(show | |
(expanded-module+symbol->identifier path-str exp-mod-stx | |
'some-module-binding)) | |
;; '(#<module-path-index='|expanded module|> ; O_o | |
;; some-module-binding | |
;; #<module-path-index='|expanded module|> ; O_o | |
;; some-module-binding | |
;; 0 | |
;; 0 | |
;; 0) | |
;; Some other ways create an identifier that doesn't match the | |
;; module binding at all. | |
(show (namespace-symbol->identifier 'some-module-binding)) | |
;; #f | |
(show (namespace-syntax-introduce (datum->syntax #f 'some-module-binding))) | |
;; #f | |
(show (namespace-syntax-introduce (datum->syntax exp-mod-stx 'some-module-binding))) | |
;; #f | |
)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment