1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
|
;; Copyright (c) 2013-2022 by Greg Hendershott.
;; SPDX-License-Identifier: GPL-3.0-or-later
#lang racket/base
(require racket/contract
racket/format
racket/match
racket/set
(only-in racket/sequence in-syntax))
(provide imports)
;;; Finding completion candidates from imports
;; drracket/check-syntax tells us about local definitions (which is
;; great!), and, tells us about imported definitions -- but only those
;; already _used_. Obviously, a major use case for completion is
;; typing _new_ uses of available definitions, too. e.g. "What is that
;; string-xxx function I'm not yet using in this file?" So we want to
;; supply that full set.
;;
;; If you have a namespace from module->namespace, you can use
;; namespace-mapped-symbols -- easy! However we do NOT want to
;; instantiate the module, i.e. "run the user's code". We want to
;; supply this information using the same sort of "passive" analaysis
;; done by check-syntax, before the user even runs the file (if ever).
;;
;; module->exports is a good starting point, but not the whole answer:
;; Imports can be filtered and renamed -- e.g. only-in, except-in,
;; prefix-in, rename-in.
;;
;; AFAICT there is no good way to get completions from all imported
;; identifiers, except attempting to parse the complete #%require
;; grammar including `prefix` and renaming forms like `just-meta`, and
;; apply that information to tweak the answer from module->exports.
;; It is important to run this with the correct parameterization of
;; current-namespace and current-load-relative-directory.
(define/contract (imports stx)
(->* (syntax?) hash?)
(define ht (make-hash))
(define (update! rmp f)
(hash-update! ht (~a (syntax->datum rmp)) f (set)))
(define (add! rmp v)
(update! rmp (λ (s) (set-add s (->str v)))))
(define (remove! rmp v)
(update! rmp (λ (s) (set-remove s (->str v)))))
(define (add-set! rmp set-of-strings)
(update! rmp (λ (s) (set-union s set-of-strings))))
(define (remove-set! rmp set-of-strings)
(update! rmp (λ (s) (set-subtract s set-of-strings))))
(define (handle-module stx)
(syntax-case stx (module #%module-begin #%plain-module-begin)
[(module id lang (#%module-begin e ...))
(handle-module-level #'id #'lang #'(e ...))]
[(module id lang (#%plain-module-begin e ...))
(handle-module-level #'id #'lang #'(e ...))]))
(define (handle-module-level id lang es)
(unless (equal? (syntax-e id) 'configure-runtime)
(module-exported-strings lang lang))
(for ([e (in-syntax es)])
(syntax-case* e (#%require module module*) symbolic-compare?
[(#%require e ...)
(unless (equal? (syntax-e id) 'configure-runtime)
(for ([spec (in-syntax #'(e ...))])
(handle-raw-require-spec spec lang)))]
[(module id sub-mod-lang (_mb e ...))
(handle-module-level #'id #'sub-mod-lang #'(e ...))]
[(module* id sub-mod-lang (_mb e ...))
(handle-module-level #'id
(if (syntax-e #'sub-mod-lang)
#'sub-mod-lang
lang)
#'(e ...))]
[ _ (void)])))
(define (handle-raw-require-spec spec lang)
(let loop ([spec spec])
(syntax-case* spec
(for-meta for-syntax for-template for-label just-meta for-space just-space portal)
symbolic-compare?
[(for-meta _phase specs ...)
(for ([spec (in-syntax #'(specs ...))])
(loop spec))]
[(for-syntax specs ...)
(for ([spec (in-syntax #'(specs ...))])
(loop spec))]
[(for-template specs ...)
(for ([spec (in-syntax #'(specs ...))])
(loop spec))]
[(for-label specs ...)
(for ([spec (in-syntax #'(specs ...))])
(loop spec))]
[(just-meta _phase specs ...)
(for ([spec (in-syntax #'(specs ...))])
(loop spec))]
[(for-space _space specs ...)
(for ([spec (in-syntax #'(specs ...))])
(loop spec))]
[(just-space _space specs ...)
(for ([spec (in-syntax #'(specs ...))])
(loop spec))]
[(portal id content) (void)]
[raw-module-path
(handle-phaseless-spec #'raw-module-path lang)])))
(define (handle-phaseless-spec spec lang)
(syntax-case* spec (only prefix all-except prefix-all-except rename)
symbolic-compare?
[(only raw-module-path id ...)
(add-set! #'raw-module-path
(syntax->string-set (syntax->list #'(id ...))))]
[(prefix prefix-id raw-module-path)
(module-exported-strings #'raw-module-path
lang
#:prefix #'prefix-id)]
[(all-except raw-module-path id ...)
(module-exported-strings #'raw-module-path
lang
#:except (syntax->string-set #'(id ...)))]
[(prefix-all-except prefix-id raw-module-path id ...)
(module-exported-strings #'raw-module-path
lang
#:prefix #'prefix-id
#:except (syntax->string-set #'(id ...)))]
[(rename raw-module-path local-id exported-id)
(begin
(unless (eq? (syntax-e #'raw-module-path) (syntax-e lang))
(remove! #'raw-module-path #'exported-id))
(add! #'raw-module-path #'local-id))]
[raw-module-path
(module-path? (syntax->datum #'raw-module-path))
(module-exported-strings #'raw-module-path
lang)]))
(define (module-exported-strings raw-module-path
lang
#:except [exceptions (set)]
#:prefix [prefix #f])
;; NOTE: Important to run module->exports with the correct
;; parameterization of current-namespace and
;; current-load-relative-directory.
;;
;; Ignore module paths module->exports can't handle, including
;; paths like 'foo or (submod "." _) or (submod ".." _). We get
;; completion candidates from drracket/check-syntax for
;; non-imported bindings. Our contribution is imported
;; definitions.
(define-values (vars stxs)
(with-handlers ([exn:fail? (λ _ (values #f #f))])
(module->exports (syntax->datum raw-module-path))))
(when (and vars stxs)
(define orig
(for*/set ([vars+stxs (in-list (list vars stxs))]
[phases (in-list vars+stxs)]
[export (in-list (cdr phases))])
(->str (car export))))
;; If imports are from the module language, then {except rename
;; prefix}-in do NOT remove imports under the original name.
;; Otherwise they do.
(if (eq? (syntax-e raw-module-path) (syntax-e lang))
(add-set! raw-module-path orig)
(remove-set! raw-module-path exceptions))
(if prefix
(for ([v (in-set orig)])
(add! raw-module-path (~a prefix (->str v))))
(add-set! raw-module-path orig))))
(handle-module stx)
ht)
(define (->str v)
(match v
[(? syntax?) (->str (syntax-e v))]
[(? symbol?) (symbol->string v)]
[(? string?) v]))
(define (syntax->string-set s)
(for/set ([s (in-syntax s)])
(->str s)))
(define (symbolic-compare? x y)
(eq? (syntax-e x) (syntax-e y)))
(module+ completions-example
(parameterize ([current-namespace (make-base-namespace)])
(define stx
(expand
#'(module m racket/base
(module sub racket/base (void))
(require racket/require
(submod "." sub)
(prefix-in XXX: (except-in racket/file other-write-bit))
(rename-in racket/path [path-only PATH-ONLY])))))
(syntax->datum stx)
(imports stx)))
(module+ completions-example-2
(require "syntax.rkt")
(parameterize ([current-namespace (make-base-empty-namespace)])
(string->expanded-syntax "/tmp/foo.rkt" "#lang rhombus\n"
imports)))
(module+ test
(require rackunit
version/utils)
;; To compare the results to namespace-mapped-symbols.
(module mod racket/base
(module sub racket/base
(define provided-by-submodule 42)
(provide provided-by-submodule))
(require (rename-in racket/path
[path-only PATH-ONLY])
(except-in racket/base println)
(rename-in racket/base
[display DISPLAY])
(prefix-in PREFIX: (only-in racket/base displayln))
(for-syntax (rename-in racket/syntax [format-id FORMAT-ID]))
(submod "." sub))
(define-namespace-anchor nsa)
(define nsms (map symbol->string
(namespace-mapped-symbols
(namespace-anchor->namespace nsa))))
(provide nsms))
(require 'mod)
(define mod/stx
(expand
#`(module mod racket/base
(module sub racket/base
(define provided-by-submodule 42)
(provide provided-by-submodule))
(require (rename-in racket/path
[path-only PATH-ONLY])
(except-in racket/base println)
(rename-in racket/base
[display DISPLAY])
(prefix-in PREFIX: (only-in racket/base displayln))
(for-syntax (rename-in racket/syntax [format-id FORMAT-ID]))
(submod "." sub))
(eprintf "I should not print!"))))
(let (;; The world according to `namespace-mapped-symbols`
[nsms (list->set nsms)]
;; The world according to our `imports`
[cs (parameterize ([current-namespace (make-base-namespace)])
(define stx (expand mod/stx))
(time (imports stx)))])
;; Test {prefix rename except}-in, keeping mind that they work
;; differently for requires that modify the module language
;; imports.
(check-false (set-member? (hash-ref cs "racket/path") "path-only")
"rename-in not from module language hides old name")
(check-true (set-member? (hash-ref cs "racket/path") "PATH-ONLY")
"rename-in not from module language has new name ")
(check-true (set-member? (hash-ref cs "racket/base") "display")
"rename-in from module language does not hide old name")
(check-true (set-member? (hash-ref cs "racket/base") "DISPLAY")
"rename-in from module language has new name")
(check-true (set-member? (hash-ref cs "racket/base") "displayln")
"prefix-in from module language does not hide old name")
(check-true (set-member? (hash-ref cs "racket/base") "PREFIX:displayln")
"prefix-in from module language is available under new name")
;; namespace-mapped-symbols will return some definitions beyond
;; those imported -- it includes {top module}-level bindings. This
;; test accounts for that with a dumb ad hoc list. (More nifty
;; would be to walk our test stx and build that list.)
;;
;; FIXME? Travis CI says this test fails prior to Racket 7.0:
;; namespace-mapped-symbols reports ~400 more symbols --
;; apparently from full racket (should be racket/base). Huh??
;; Well, _our_ results are correct. For now, let's just do the
;; test on Racket 7.0+.
(when (version<=? "7.0" (version))
(check-equal? (set-subtract nsms (apply set-union (hash-values cs)))
(set "tmp.1" "nsms" "nsa" "provided-by-submodule")
"namespace-mapped-symbols returns only a few more, non-imported definitions")))
;; Issue 481
(check-not-exn (λ () (imports
(expand
#`(module mod racket/base
(module sub1 racket/base)
(module sub2 racket/base
(require (submod ".." sub1)))))))))
(module+ slow-test
;; Exercise our parsing of the #%require grammar: Try doing
;; (check-not-exn (imports stx)) on many files in the Racket
;; distribution. Grammar mistakes will raise exn:fail:syntax.
(require rackunit
racket/path
"syntax.rkt")
(define (check path)
(parameterize ([current-load-relative-directory (path-only path)]
[current-namespace (make-base-namespace)])
(file->expanded-syntax
path
(λ (stx)
(check-not-exn (λ () (imports stx))
(format "#%require grammar handles ~v" path))))))
(for* ([roots (in-list '(("racket.rkt" "typed")
("core.rkt" "typed-racket")
("main.rkt" "racket")))]
[path (in-directory
(path-only
(apply collection-file-path roots)))]
#:when (equal? #"rkt" (filename-extension path)))
(println path)
(check path)))
|
