module->exports: add information about defined name
Include the defined name (in addition to the provided name) in the result of `module->exports` and `module-compiled-exports` --- but for backward compatibility, only if the new optional `verbosity` argument is 'defined-names.
This commit is contained in:
Matthew Flatt
parent
e82c60a0e1
commit
e8f5501e29
|
|
@ -12,7 +12,7 @@
|
|||
|
||||
(define collection 'multi)
|
||||
|
||||
(define version "7.5.0.5")
|
||||
(define version "7.5.0.6")
|
||||
|
||||
(define deps `("racket-lib"
|
||||
["racket" #:version ,version]))
|
||||
|
|
|
|||
|
|
@ -396,9 +396,10 @@ to a shift into the @tech{label phase level}) to module references for
|
|||
the module's explicit imports.}
|
||||
|
||||
|
||||
@defproc[(module-compiled-exports [compiled-module-code compiled-module-expression?])
|
||||
@defproc[(module-compiled-exports [compiled-module-code compiled-module-expression?]
|
||||
[verbosity (or/c #f 'defined-names) #f])
|
||||
(values (listof (cons/c (or/c exact-integer? #f) list?))
|
||||
(listof (cons/c (or/c exact-integer? #f) list?)))]
|
||||
(listof (cons/c (or/c exact-integer? #f) list?)))]{
|
||||
|
||||
Returns two association lists mapping @tech{phase level} values (where
|
||||
@racket[#f] corresponds to the @tech{label phase level}) to exports at
|
||||
|
|
@ -417,7 +418,9 @@ result contracts above, more precisely matches the contract
|
|||
(list/c module-path-index?
|
||||
(or/c exact-integer? #f)
|
||||
symbol?
|
||||
(or/c exact-integer? #f))))))
|
||||
(or/c exact-integer? #f))))
|
||||
(code:comment @#,elem{only if @racket[verbosity] is @racket['defined-names]:})
|
||||
symbol?))
|
||||
]
|
||||
|
||||
For each element of the list, the leading symbol is the name of the
|
||||
|
|
@ -431,6 +434,11 @@ origin list provides information on the import that was re-exported.
|
|||
The origin list has more than one element if the binding was imported
|
||||
multiple times from (possibly) different sources.
|
||||
|
||||
The last part, a symbol, is included only if @racket[verbosity] is
|
||||
@racket['defined-names]. In that case, the included symbol is the name
|
||||
of the definition within its defining module (which may be different
|
||||
than the name that is exported).
|
||||
|
||||
For each origin, a @tech{module path index} by itself means that the
|
||||
binding was imported with a @tech{phase level} shift of @racket[0]
|
||||
(i.e., a plain @racket[require] without @racket[for-meta],
|
||||
|
|
@ -439,7 +447,26 @@ as the re-exported name. An origin represented with a list indicates
|
|||
explicitly the import, the import @tech{phase level} shift (where
|
||||
@racket[#f] corresponds to a @racket[for-label] import), the import
|
||||
name of the re-exported binding, and the @tech{phase level} of the
|
||||
import.}
|
||||
import.
|
||||
|
||||
@examples[#:eval mod-eval
|
||||
(module-compiled-exports
|
||||
(compile
|
||||
'(module banana racket/base
|
||||
(require (only-in racket/math pi)
|
||||
(for-syntax racket/base))
|
||||
(provide pi
|
||||
(rename-out [peel wrapper])
|
||||
bush
|
||||
cond
|
||||
(for-syntax compile-time))
|
||||
(define peel pi)
|
||||
(define bush (* 2 pi))
|
||||
(begin-for-syntax
|
||||
(define compile-time (current-seconds)))))
|
||||
'defined-names)]
|
||||
|
||||
@history[#:changed "7.5.0.6" @elem{Added the @racket[verbosity] argument.}]}
|
||||
|
||||
|
||||
|
||||
|
|
@ -662,7 +689,8 @@ A module can be @tech{declare}d by using @racket[dynamic-require].
|
|||
|
||||
|
||||
@defproc[(module->exports
|
||||
[mod (or/c module-path? resolved-module-path?)])
|
||||
[mod (or/c module-path? resolved-module-path?)]
|
||||
[verbosity (or/c #f 'defined-names) #f])
|
||||
(values (listof (cons/c (or/c exact-integer? #f) list?))
|
||||
(listof (cons/c (or/c exact-integer? #f) list?)))]{
|
||||
|
||||
|
|
@ -675,10 +703,13 @@ A module can be @tech{declare}d by using @racket[dynamic-require].
|
|||
@examples[#:eval mod-eval
|
||||
(module banana racket/base
|
||||
(require (only-in racket/math pi))
|
||||
(provide peel)
|
||||
(provide (rename-out [peel wrapper]))
|
||||
(define peel pi)
|
||||
(define bush (* 2 pi)))
|
||||
(module->exports ''banana)]}
|
||||
(module->exports ''banana)]
|
||||
|
||||
@history[#:changed "7.5.0.6" @elem{Added the @racket[verbosity] argument.}]}
|
||||
|
||||
|
||||
@defproc[(module->indirect-exports
|
||||
[mod (or/c module-path? resolved-module-path?)])
|
||||
|
|
|
|||
|
|
@ -2504,6 +2504,56 @@ case of module-leve bindings; it doesn't cover local bindings.
|
|||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
|
||||
(module m1-expansion-defines-and-provides-m2 racket/base
|
||||
(require (for-syntax racket/base))
|
||||
(provide m1)
|
||||
(define-syntax (m1 stx)
|
||||
#'(begin
|
||||
(provide m2)
|
||||
(define m2 42))))
|
||||
|
||||
(module defines-and-provides-m2 racket/base
|
||||
(provide add1)
|
||||
(require 'm1-expansion-defines-and-provides-m2)
|
||||
(m1))
|
||||
|
||||
|
||||
(let-values ([(vals stxes) (module->exports ''defines-and-provides-m2 'defined-names)])
|
||||
(test '(3 3) map length (cdr (assq 0 vals)))
|
||||
(test (string->unreadable-symbol "m2.1") 'module->exports
|
||||
(for/first ([v (in-list (cdr (assq 0 vals)))]
|
||||
#:when (eq? (car v) 'm2))
|
||||
(caddr v)))
|
||||
(test #t 'module->exports (and (memq 'add1 (map car (cdr (assq 0 vals)))) #t))
|
||||
(test null values stxes))
|
||||
|
||||
(let-values ([(vals stxes) (module->exports ''defines-and-provides-m2)])
|
||||
(test '(2 2) map length (cdr (assq 0 vals))))
|
||||
|
||||
(err/rt-test (module->exports ''no-such-module-defined 'not-a-valid-verbosity)
|
||||
exn:fail:contract?
|
||||
#rx"not-a-valid-verbosity")
|
||||
|
||||
(let-values ([(vals stxes) (module-compiled-exports (compile '(module m racket/kernel
|
||||
(define-values (x) 1)
|
||||
(#%provide x))))])
|
||||
(test null values stxes)
|
||||
(test '(2) map length (cdr (assq 0 vals))))
|
||||
|
||||
(let-values ([(vals stxes) (module-compiled-exports (compile '(module m racket/kernel
|
||||
(define-values (x) 1)
|
||||
(#%provide x)))
|
||||
'defined-names)])
|
||||
(test null values stxes)
|
||||
(test '(3) map length (cdr (assq 0 vals))))
|
||||
|
||||
(err/rt-test (module-compiled-exports 'no #f))
|
||||
(err/rt-test (module-compiled-exports (compile '(module m racket/kernel)) 'not-a-valid-verbosity)
|
||||
#rx"not-a-valid-verbosity")
|
||||
|
||||
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(let ([check
|
||||
(lambda (later rx)
|
||||
(err/rt-test (expand `(module m racket/base
|
||||
|
|
|
|||
|
|
@ -38,11 +38,13 @@
|
|||
(define inst (compiled-module->declaration-instance c))
|
||||
(instance-variable-value inst 'requires))
|
||||
|
||||
(define/who (module-compiled-exports c)
|
||||
(define/who (module-compiled-exports c [verbosity #f])
|
||||
(check who compiled-module-expression? c)
|
||||
(check-provides-verbosity who verbosity)
|
||||
(define inst (compiled-module->declaration-instance c))
|
||||
(provides->api-provides (instance-variable-value inst 'provides)
|
||||
(instance-variable-value inst 'self-mpi)))
|
||||
(instance-variable-value inst 'self-mpi)
|
||||
verbosity))
|
||||
|
||||
(define/who (module-compiled-indirect-exports c)
|
||||
(check who compiled-module-expression? c)
|
||||
|
|
|
|||
|
|
@ -34,8 +34,10 @@
|
|||
(define m (namespace->module ns name))
|
||||
(and m (module-is-predefined? m)))
|
||||
|
||||
(define (module-> extract who mod [load? #f])
|
||||
(define (module-> extract who mod [load? #f]
|
||||
#:extra-checks [extra-checks void])
|
||||
(check who module-reference? #:contract module-reference-str mod)
|
||||
(extra-checks)
|
||||
(define m (namespace->module/complain who
|
||||
(current-namespace)
|
||||
(reference->resolved-module-path mod #:load? load?)))
|
||||
|
|
@ -47,10 +49,12 @@
|
|||
(define/who (module->imports mod)
|
||||
(module-> module-requires who mod))
|
||||
|
||||
(define (module->exports mod)
|
||||
(define/who (module->exports mod [verbosity #f])
|
||||
(define-values (provides self)
|
||||
(module-> (lambda (m) (values (module-provides m) (module-self m))) 'module->exports mod))
|
||||
(provides->api-provides provides self))
|
||||
(module-> (lambda (m) (values (module-provides m) (module-self m))) who mod
|
||||
#:extra-checks (lambda ()
|
||||
(check-provides-verbosity who verbosity))))
|
||||
(provides->api-provides provides self verbosity))
|
||||
|
||||
(define (module->indirect-exports mod)
|
||||
(module-> (lambda (m)
|
||||
|
|
|
|||
|
|
@ -4,10 +4,17 @@
|
|||
"../common/module-path.rkt"
|
||||
"../syntax/module-binding.rkt")
|
||||
|
||||
(provide provides->api-provides
|
||||
(provide check-provides-verbosity
|
||||
provides->api-provides
|
||||
variables->api-nonprovides)
|
||||
|
||||
(define (provides->api-provides provides self)
|
||||
(define (check-provides-verbosity who verbosity)
|
||||
(unless (or (not verbosity)
|
||||
(eq? verbosity 'defined-names))
|
||||
(raise-argument-error who "(or/c #f 'defined-names)" verbosity)))
|
||||
|
||||
(define (provides->api-provides provides self verbosity)
|
||||
(define defined-names? (eq? verbosity 'defined-names))
|
||||
(define (extract ok?)
|
||||
(define result-l
|
||||
(for*/list ([(phase at-phase) (in-hash provides)]
|
||||
|
|
@ -15,7 +22,7 @@
|
|||
(for/list ([(sym b/p) (in-hash at-phase)]
|
||||
#:when (ok? b/p))
|
||||
(define b (provided-as-binding b/p))
|
||||
(list sym
|
||||
(list* sym
|
||||
(cond
|
||||
[(eq? self (module-binding-module b))
|
||||
null]
|
||||
|
|
@ -30,7 +37,10 @@
|
|||
(list (module-binding-nominal-module b)
|
||||
(module-binding-phase b)
|
||||
(module-binding-nominal-sym b)
|
||||
(module-binding-nominal-phase b))]))]))))]
|
||||
(module-binding-nominal-phase b))]))])
|
||||
(if defined-names?
|
||||
(list (module-binding-sym b))
|
||||
null))))]
|
||||
#:unless (null? l))
|
||||
(cons phase (sort l symbol<? #:key car))))
|
||||
(sort result-l phase<? #:key car))
|
||||
|
|
|
|||
|
|
@ -16,7 +16,7 @@
|
|||
#define MZSCHEME_VERSION_X 7
|
||||
#define MZSCHEME_VERSION_Y 5
|
||||
#define MZSCHEME_VERSION_Z 0
|
||||
#define MZSCHEME_VERSION_W 5
|
||||
#define MZSCHEME_VERSION_W 6
|
||||
|
||||
/* A level of indirection makes `#` work as needed: */
|
||||
#define AS_a_STR_HELPER(x) #x
|
||||
|
|
|
|||
|
|
@ -18258,13 +18258,14 @@ static const char *startup_source =
|
|||
"(define-values(fasl-hash-equal-variant) 1)"
|
||||
"(define-values(fasl-hash-eqv-variant) 2)"
|
||||
"(define-values"
|
||||
"(s-exp->fasl11.1)"
|
||||
"(lambda(keep-mutable?7_0 v10_0 orig-o9_0)"
|
||||
"(s-exp->fasl13.1)"
|
||||
"(lambda(handle-fail8_0 keep-mutable?7_0 v12_0 orig-o11_0)"
|
||||
"(begin"
|
||||
" 's-exp->fasl11"
|
||||
"(let-values(((v_0) v10_0))"
|
||||
"(let-values(((orig-o_0) orig-o9_0))"
|
||||
" 's-exp->fasl13"
|
||||
"(let-values(((v_0) v12_0))"
|
||||
"(let-values(((orig-o_0) orig-o11_0))"
|
||||
"(let-values(((keep-mutable?_0) keep-mutable?7_0))"
|
||||
"(let-values(((handle-fail_0) handle-fail8_0))"
|
||||
"(let-values()"
|
||||
"(let-values((()"
|
||||
"(begin"
|
||||
|
|
@ -18276,7 +18277,21 @@ static const char *startup_source =
|
|||
" (raise-argument-error 'fasl->s-exp \"(or/c output-port? #f)\" orig-o_0))))"
|
||||
"(void))"
|
||||
"(values))))"
|
||||
"(let-values(((o_0)(let-values(((or-part_0) orig-o_0))(if or-part_0 or-part_0(open-output-bytes)))))"
|
||||
"(let-values((()"
|
||||
"(begin"
|
||||
"(if handle-fail_0"
|
||||
"(let-values()"
|
||||
"(if(if(procedure? handle-fail_0)(procedure-arity-includes? handle-fail_0 1) #f)"
|
||||
"(void)"
|
||||
"(let-values()"
|
||||
"(raise-argument-error"
|
||||
" 'fasl->s-exp"
|
||||
" \"(or/c (procedure-arity-includes/c 1) #f)\""
|
||||
" handle-fail_0))))"
|
||||
"(void))"
|
||||
"(values))))"
|
||||
"(let-values(((o_0)"
|
||||
"(let-values(((or-part_0) orig-o_0))(if or-part_0 or-part_0(open-output-bytes)))))"
|
||||
"(let-values(((shared_0)(make-hasheq)))"
|
||||
"(let-values(((shared-counter_0) 0))"
|
||||
"(let-values((()"
|
||||
|
|
@ -18412,7 +18427,8 @@ static const char *startup_source =
|
|||
"(void)))"
|
||||
" c1_0)"
|
||||
"(if(srcloc? v_1)"
|
||||
"(let-values()(loop_0(srcloc-source v_1)))"
|
||||
"(let-values()"
|
||||
"(loop_0(srcloc-source v_1)))"
|
||||
"(if(correlated?$1 v_1)"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
|
|
@ -18485,16 +18501,20 @@ static const char *startup_source =
|
|||
" 'loop"
|
||||
"(if(not(eq?(hash-ref shared_0 v_1 1) 1))"
|
||||
"(let-values()"
|
||||
"(let-values(((c_0)(hash-ref shared_0 v_1)))"
|
||||
"(let-values(((c_0)"
|
||||
"(hash-ref shared_0 v_1)))"
|
||||
"(if(negative? c_0)"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
"(1/write-byte fasl-graph-ref-type o_1)"
|
||||
"(1/write-byte"
|
||||
" fasl-graph-ref-type"
|
||||
" o_1)"
|
||||
"(write-fasl-integer"
|
||||
"(sub1(- c_0))"
|
||||
" o_1)))"
|
||||
"(let-values()"
|
||||
"(let-values(((pos_0) shared-counter_0))"
|
||||
"(let-values(((pos_0)"
|
||||
" shared-counter_0))"
|
||||
"(begin"
|
||||
"(set! shared-counter_0"
|
||||
"(add1 shared-counter_0))"
|
||||
|
|
@ -18522,7 +18542,9 @@ static const char *startup_source =
|
|||
"(1/write-byte fasl-void-type o_1))"
|
||||
"(if(eof-object? v_1)"
|
||||
"(let-values()"
|
||||
"(1/write-byte fasl-eof-type o_1))"
|
||||
"(1/write-byte"
|
||||
" fasl-eof-type"
|
||||
" o_1))"
|
||||
"(if(exact-integer? v_1)"
|
||||
"(let-values()"
|
||||
"(if(<="
|
||||
|
|
@ -18591,7 +18613,8 @@ static const char *startup_source =
|
|||
" v_1))))"
|
||||
"(begin"
|
||||
"(write-fasl-integer"
|
||||
"(bytes-length bstr_0)"
|
||||
"(bytes-length"
|
||||
" bstr_0)"
|
||||
" o_1)"
|
||||
"(1/write-bytes"
|
||||
" bstr_0"
|
||||
|
|
@ -18602,9 +18625,11 @@ static const char *startup_source =
|
|||
"(1/write-byte"
|
||||
" fasl-rational-type"
|
||||
" o_1)"
|
||||
"(loop_0(numerator v_1))"
|
||||
"(loop_0"
|
||||
"(denominator v_1))))"
|
||||
"(numerator v_1))"
|
||||
"(loop_0"
|
||||
"(denominator"
|
||||
" v_1))))"
|
||||
"(if(complex? v_1)"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
|
|
@ -18614,7 +18639,8 @@ static const char *startup_source =
|
|||
"(loop_0"
|
||||
"(real-part v_1))"
|
||||
"(loop_0"
|
||||
"(imag-part v_1))))"
|
||||
"(imag-part"
|
||||
" v_1))))"
|
||||
"(if(char? v_1)"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
|
|
@ -18622,7 +18648,8 @@ static const char *startup_source =
|
|||
" fasl-char-type"
|
||||
" o_1)"
|
||||
"(write-fasl-integer"
|
||||
"(char->integer v_1)"
|
||||
"(char->integer"
|
||||
" v_1)"
|
||||
" o_1)))"
|
||||
"(if(symbol? v_1)"
|
||||
"(let-values()"
|
||||
|
|
@ -18677,7 +18704,8 @@ static const char *startup_source =
|
|||
"(1/write-bytes"
|
||||
" bstr_0"
|
||||
" o_1)))))"
|
||||
"(if(string? v_1)"
|
||||
"(if(string?"
|
||||
" v_1)"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
"(write-fasl-integer"
|
||||
|
|
@ -18689,7 +18717,8 @@ static const char *startup_source =
|
|||
"(write-fasl-string"
|
||||
" v_1"
|
||||
" o_1)))"
|
||||
"(if(bytes? v_1)"
|
||||
"(if(bytes?"
|
||||
" v_1)"
|
||||
"(let-values()"
|
||||
"(begin"
|
||||
"(write-fasl-integer"
|
||||
|
|
@ -19159,11 +19188,15 @@ static const char *startup_source =
|
|||
" fasl-undefined-type"
|
||||
" o_1))"
|
||||
"(let-values()"
|
||||
"(if handle-fail_0"
|
||||
"(loop_0"
|
||||
"(handle-fail_0"
|
||||
" v_1))"
|
||||
"(raise-arguments-error"
|
||||
" 's-exp->fasl"
|
||||
" \"cannot write value\""
|
||||
" \"value\""
|
||||
" v_1)))))))))))))))))))))))))))))))))))"
|
||||
" v_1))))))))))))))))))))))))))))))))))))"
|
||||
" loop_0)"
|
||||
" v_0)"
|
||||
"(get-output-bytes o_1 #t)))))"
|
||||
|
|
@ -19171,14 +19204,14 @@ static const char *startup_source =
|
|||
"(write-fasl-integer shared-counter_0 o_0)"
|
||||
"(write-fasl-integer(bytes-length bstr_0) o_0)"
|
||||
"(1/write-bytes bstr_0 o_0)"
|
||||
"(if orig-o_0(void)(get-output-bytes o_0)))))))))))))))))))"
|
||||
"(if orig-o_0(void)(get-output-bytes o_0)))))))))))))))))))))"
|
||||
"(define-values"
|
||||
"(fasl->s-exp17.1)"
|
||||
"(lambda(datum-intern?14_0 orig-i16_0)"
|
||||
"(fasl->s-exp19.1)"
|
||||
"(lambda(datum-intern?16_0 orig-i18_0)"
|
||||
"(begin"
|
||||
" 'fasl->s-exp17"
|
||||
"(let-values(((orig-i_0) orig-i16_0))"
|
||||
"(let-values(((intern?_0) datum-intern?14_0))"
|
||||
" 'fasl->s-exp19"
|
||||
"(let-values(((orig-i_0) orig-i18_0))"
|
||||
"(let-values(((intern?_0) datum-intern?16_0))"
|
||||
"(let-values()"
|
||||
"(let-values(((init-i_0)"
|
||||
"(if(bytes? orig-i_0)"
|
||||
|
|
@ -19864,17 +19897,17 @@ static const char *startup_source =
|
|||
" (let-values () (read-error \"internal error on integer mode\"))))))))))))"
|
||||
"(define-values"
|
||||
"(read-fasl-string)"
|
||||
"(let-values(((read-fasl-string22_0)"
|
||||
"(lambda(i21_0 len20_0)"
|
||||
"(let-values(((read-fasl-string24_0)"
|
||||
"(lambda(i23_0 len22_0)"
|
||||
"(begin"
|
||||
" 'read-fasl-string22"
|
||||
"(let-values(((i_0) i21_0))"
|
||||
"(let-values(((len_0)(if(eq? len20_0 unsafe-undefined)(read-fasl-integer i_0) len20_0)))"
|
||||
" 'read-fasl-string24"
|
||||
"(let-values(((i_0) i23_0))"
|
||||
"(let-values(((len_0)(if(eq? len22_0 unsafe-undefined)(read-fasl-integer i_0) len22_0)))"
|
||||
"(let-values()"
|
||||
"(let-values(((bstr_0)(read-bytes/exactly len_0 i_0)))(bytes->string/utf-8 bstr_0)))))))))"
|
||||
"(case-lambda"
|
||||
"((i_0)(begin(read-fasl-string22_0 i_0 unsafe-undefined)))"
|
||||
"((i_0 len20_0)(read-fasl-string22_0 i_0 len20_0)))))"
|
||||
"((i_0)(begin(read-fasl-string24_0 i_0 unsafe-undefined)))"
|
||||
"((i_0 len22_0)(read-fasl-string24_0 i_0 len22_0)))))"
|
||||
"(define-values"
|
||||
"(read-fasl-bytes)"
|
||||
"(lambda(i_0)(begin(let-values(((len_0)(read-fasl-integer i_0)))(read-bytes/exactly len_0 i_0)))))"
|
||||
|
|
@ -29018,7 +29051,7 @@ static const char *startup_source =
|
|||
"(define-values"
|
||||
"(write-correlated-linklet-bundle-hash)"
|
||||
"(lambda(ht_0 o_0)"
|
||||
"(begin(let-values(((temp7_0)(->faslable ht_0))((o8_0) o_0))(s-exp->fasl11.1 #f temp7_0 o8_0)))))"
|
||||
"(begin(let-values(((temp7_0)(->faslable ht_0))((o8_0) o_0))(s-exp->fasl13.1 #f #f temp7_0 o8_0)))))"
|
||||
"(define-values"
|
||||
"(->faslable)"
|
||||
"(lambda(v_0)"
|
||||
|
|
@ -29171,7 +29204,7 @@ static const char *startup_source =
|
|||
"(let-values() v_0))))))))"
|
||||
"(define-values"
|
||||
"(read-correlated-linklet-bundle-hash)"
|
||||
"(lambda(in_0)(begin(faslable->(let-values(((in9_0) in_0)((temp10_0) #t))(fasl->s-exp17.1 temp10_0 in9_0))))))"
|
||||
"(lambda(in_0)(begin(faslable->(let-values(((in9_0) in_0)((temp10_0) #t))(fasl->s-exp19.1 temp10_0 in9_0))))))"
|
||||
"(define-values"
|
||||
"(faslable->)"
|
||||
"(lambda(v_0)"
|
||||
|
|
@ -38535,9 +38568,17 @@ static const char *startup_source =
|
|||
"(hash-iterate-first ht_0)))))))"
|
||||
"(define-values(eval-linklet*)(lambda(l_0)(begin(1/eval-linklet(force-compile-linklet l_0)))))"
|
||||
"(define-values"
|
||||
"(provides->api-provides)"
|
||||
"(lambda(provides_0 self_0)"
|
||||
"(check-provides-verbosity)"
|
||||
"(lambda(who_0 verbosity_0)"
|
||||
"(begin"
|
||||
"(if(let-values(((or-part_0)(not verbosity_0)))(if or-part_0 or-part_0(eq? verbosity_0 'defined-names)))"
|
||||
"(void)"
|
||||
" (let-values () (raise-argument-error who_0 \"(or/c #f 'defined-names)\" verbosity_0))))))"
|
||||
"(define-values"
|
||||
"(provides->api-provides)"
|
||||
"(lambda(provides_0 self_0 verbosity_0)"
|
||||
"(begin"
|
||||
"(let-values(((defined-names?_0)(eq? verbosity_0 'defined-names)))"
|
||||
"(let-values(((extract_0)"
|
||||
"(lambda(ok?_0)"
|
||||
"(begin"
|
||||
|
|
@ -38593,7 +38634,7 @@ static const char *startup_source =
|
|||
"(let-values(((b_0)"
|
||||
"(provided-as-binding"
|
||||
" b/p_0)))"
|
||||
"(list"
|
||||
"(list*"
|
||||
" sym_0"
|
||||
"(if(eq?"
|
||||
" self_0"
|
||||
|
|
@ -38669,7 +38710,12 @@ static const char *startup_source =
|
|||
" fold-var_4)))))"
|
||||
" for-loop_2)"
|
||||
" null"
|
||||
" lst_0)))))))))"
|
||||
" lst_0))))))"
|
||||
"(if defined-names?_0"
|
||||
"(list"
|
||||
"(module-binding-sym"
|
||||
" b_0))"
|
||||
" null))))"
|
||||
" fold-var_3))))"
|
||||
"(values"
|
||||
" fold-var_4)))"
|
||||
|
|
@ -38738,7 +38784,7 @@ static const char *startup_source =
|
|||
"(sort7.1 #f car3_0 result-l1_0 phase<?2_0)))))))"
|
||||
"(values"
|
||||
"(extract_0(lambda(b/p_0)(not(provided-as-transformer? b/p_0))))"
|
||||
"(extract_0 provided-as-transformer?))))))"
|
||||
"(extract_0 provided-as-transformer?)))))))"
|
||||
"(define-values"
|
||||
"(variables->api-nonprovides)"
|
||||
"(lambda(provides_0 all-vars_0)"
|
||||
|
|
@ -39291,9 +39337,13 @@ static const char *startup_source =
|
|||
"(1/instance-variable-value inst_0 'requires))))))))"
|
||||
"(define-values"
|
||||
"(1/module-compiled-exports)"
|
||||
"(lambda(c_0)"
|
||||
"(let-values(((module-compiled-exports3_0)"
|
||||
"(lambda(c2_0 verbosity1_0)"
|
||||
"(begin"
|
||||
" 'module-compiled-exports"
|
||||
" 'module-compiled-exports3"
|
||||
"(let-values(((c_0) c2_0))"
|
||||
"(let-values(((verbosity_0) verbosity1_0))"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values((()"
|
||||
|
|
@ -39301,12 +39351,23 @@ static const char *startup_source =
|
|||
"(if(1/compiled-module-expression? c_0)"
|
||||
"(void)"
|
||||
"(let-values()"
|
||||
" (raise-argument-error 'module-compiled-exports \"compiled-module-expression?\" c_0)))"
|
||||
"(raise-argument-error"
|
||||
" 'module-compiled-exports"
|
||||
" \"compiled-module-expression?\""
|
||||
" c_0)))"
|
||||
"(values))))"
|
||||
"(let-values((()"
|
||||
"(begin"
|
||||
"(check-provides-verbosity 'module-compiled-exports verbosity_0)"
|
||||
"(values))))"
|
||||
"(let-values(((inst_0)(compiled-module->declaration-instance c_0)))"
|
||||
"(provides->api-provides"
|
||||
"(1/instance-variable-value inst_0 'provides)"
|
||||
"(1/instance-variable-value inst_0 'self-mpi)))))))))"
|
||||
"(1/instance-variable-value inst_0 'self-mpi)"
|
||||
" verbosity_0)))))))))))))"
|
||||
"(case-lambda"
|
||||
"((c_0)(begin 'module-compiled-exports(module-compiled-exports3_0 c_0 #f)))"
|
||||
"((c_0 verbosity1_0)(module-compiled-exports3_0 c_0 verbosity1_0)))))"
|
||||
"(define-values"
|
||||
"(1/module-compiled-indirect-exports)"
|
||||
"(lambda(c_0)"
|
||||
|
|
@ -61625,8 +61686,8 @@ static const char *startup_source =
|
|||
"(values))))"
|
||||
"(let-values(((ns_0)(1/current-namespace)))"
|
||||
"(let-values(((name_0)"
|
||||
"(let-values(((mod31_0) mod_0)((load?32_0) load?_0))"
|
||||
"(reference->resolved-module-path27.1 load?32_0 mod31_0))))"
|
||||
"(let-values(((mod38_0) mod_0)((load?39_0) load?_0))"
|
||||
"(reference->resolved-module-path34.1 load?39_0 mod38_0))))"
|
||||
"(if(namespace->module ns_0 name_0) #t #f)))))))))))))"
|
||||
"(case-lambda"
|
||||
"((mod_0)(begin 'module-declared?(module-declared?3_0 mod_0 #f)))"
|
||||
|
|
@ -61646,19 +61707,19 @@ static const char *startup_source =
|
|||
"(values))))"
|
||||
"(let-values(((ns_0)(1/current-namespace)))"
|
||||
"(let-values(((name_0)"
|
||||
"(let-values(((mod34_0) mod_0)((temp35_0) #f))"
|
||||
"(reference->resolved-module-path27.1 temp35_0 mod34_0))))"
|
||||
"(let-values(((mod41_0) mod_0)((temp42_0) #f))"
|
||||
"(reference->resolved-module-path34.1 temp42_0 mod41_0))))"
|
||||
"(let-values(((m_0)(namespace->module ns_0 name_0)))(if m_0(module-is-predefined? m_0) #f))))))))))"
|
||||
"(define-values"
|
||||
"(module->)"
|
||||
"(let-values(((module->9_0)"
|
||||
"(lambda(extract6_0 who7_0 mod8_0 load?5_0)"
|
||||
"(module->11.1)"
|
||||
"(lambda(extra-checks5_0 extract8_0 who9_0 mod10_0 load?7_0)"
|
||||
"(begin"
|
||||
" 'module->9"
|
||||
"(let-values(((extract_0) extract6_0))"
|
||||
"(let-values(((who_0) who7_0))"
|
||||
"(let-values(((mod_0) mod8_0))"
|
||||
"(let-values(((load?_0) load?5_0))"
|
||||
" 'module->11"
|
||||
"(let-values(((extract_0) extract8_0))"
|
||||
"(let-values(((who_0) who9_0))"
|
||||
"(let-values(((mod_0) mod10_0))"
|
||||
"(let-values(((load?_0) load?7_0))"
|
||||
"(let-values(((extra-checks_0)(if(eq? extra-checks5_0 unsafe-undefined) void extra-checks5_0)))"
|
||||
"(let-values()"
|
||||
"(let-values((()"
|
||||
"(begin"
|
||||
|
|
@ -61666,70 +61727,110 @@ static const char *startup_source =
|
|||
"(void)"
|
||||
"(let-values()(raise-argument-error who_0 module-reference-str mod_0)))"
|
||||
"(values))))"
|
||||
"(let-values((()(begin(extra-checks_0)(values))))"
|
||||
"(let-values(((m_0)"
|
||||
"(namespace->module/complain"
|
||||
" who_0"
|
||||
"(1/current-namespace)"
|
||||
"(let-values(((mod36_0) mod_0)((load?37_0) load?_0))"
|
||||
"(reference->resolved-module-path27.1 load?37_0 mod36_0)))))"
|
||||
"(extract_0 m_0))))))))))))"
|
||||
"(case-lambda"
|
||||
"((extract_0 who_0 mod_0)(begin(module->9_0 extract_0 who_0 mod_0 #f)))"
|
||||
"((extract_0 who_0 mod_0 load?5_0)(module->9_0 extract_0 who_0 mod_0 load?5_0)))))"
|
||||
"(let-values(((mod43_0) mod_0)((load?44_0) load?_0))"
|
||||
"(reference->resolved-module-path34.1 load?44_0 mod43_0)))))"
|
||||
"(extract_0 m_0)))))))))))))"
|
||||
"(define-values"
|
||||
"(1/module->language-info)"
|
||||
"(let-values(((module->language-info13_0)"
|
||||
"(lambda(mod12_0 load?11_0)"
|
||||
"(let-values(((module->language-info16_0)"
|
||||
"(lambda(mod15_0 load?14_0)"
|
||||
"(begin"
|
||||
" 'module->language-info13"
|
||||
"(let-values(((mod_0) mod12_0))"
|
||||
"(let-values(((load?_0) load?11_0))"
|
||||
" 'module->language-info16"
|
||||
"(let-values(((mod_0) mod15_0))"
|
||||
"(let-values(((load?_0) load?14_0))"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values()(module-> module-language-info 'module->language-info mod_0 load?_0))))))))))"
|
||||
"(let-values()"
|
||||
"(let-values(((module-language-info46_0) module-language-info)"
|
||||
"((who47_0) 'module->language-info)"
|
||||
"((mod48_0) mod_0)"
|
||||
"((load?49_0) load?_0))"
|
||||
"(module->11.1"
|
||||
" unsafe-undefined"
|
||||
" module-language-info46_0"
|
||||
" who47_0"
|
||||
" mod48_0"
|
||||
" load?49_0)))))))))))"
|
||||
"(case-lambda"
|
||||
"((mod_0)(begin 'module->language-info(module->language-info13_0 mod_0 #f)))"
|
||||
"((mod_0 load?11_0)(module->language-info13_0 mod_0 load?11_0)))))"
|
||||
"((mod_0)(begin 'module->language-info(module->language-info16_0 mod_0 #f)))"
|
||||
"((mod_0 load?14_0)(module->language-info16_0 mod_0 load?14_0)))))"
|
||||
"(define-values"
|
||||
"(1/module->imports)"
|
||||
"(lambda(mod_0)"
|
||||
"(begin 'module->imports(let-values()(let-values()(module-> module-requires 'module->imports mod_0))))))"
|
||||
"(begin"
|
||||
" 'module->imports"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values(((module-requires51_0) module-requires)((who52_0) 'module->imports)((mod53_0) mod_0))"
|
||||
"(module->11.1 unsafe-undefined module-requires51_0 who52_0 mod53_0 #f)))))))"
|
||||
"(define-values"
|
||||
"(1/module->exports)"
|
||||
"(lambda(mod_0)"
|
||||
"(let-values(((module->exports20_0)"
|
||||
"(lambda(mod19_0 verbosity18_0)"
|
||||
"(begin"
|
||||
" 'module->exports"
|
||||
" 'module->exports20"
|
||||
"(let-values(((mod_0) mod19_0))"
|
||||
"(let-values(((verbosity_0) verbosity18_0))"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values(((provides_0 self_0)"
|
||||
"(module->(lambda(m_0)(values(module-provides m_0)(module-self m_0))) 'module->exports mod_0)))"
|
||||
"(provides->api-provides provides_0 self_0)))))"
|
||||
"(let-values(((temp55_0)"
|
||||
"(lambda(m_0)"
|
||||
"(begin"
|
||||
" 'temp55"
|
||||
"(values(module-provides m_0)(module-self m_0)))))"
|
||||
"((who56_0) 'module->exports)"
|
||||
"((mod57_0) mod_0)"
|
||||
"((temp58_0)"
|
||||
"(lambda()"
|
||||
"(check-provides-verbosity 'module->exports verbosity_0))))"
|
||||
"(module->11.1 temp58_0 temp55_0 who56_0 mod57_0 #f))))"
|
||||
"(provides->api-provides provides_0 self_0 verbosity_0)))))))))))"
|
||||
"(case-lambda"
|
||||
"((mod_0)(begin 'module->exports(module->exports20_0 mod_0 #f)))"
|
||||
"((mod_0 verbosity18_0)(module->exports20_0 mod_0 verbosity18_0)))))"
|
||||
"(define-values"
|
||||
"(1/module->indirect-exports)"
|
||||
"(lambda(mod_0)"
|
||||
"(begin"
|
||||
" 'module->indirect-exports"
|
||||
"(module->"
|
||||
"(lambda(m_0)(variables->api-nonprovides(module-provides m_0)((module-get-all-variables m_0))))"
|
||||
" 'module->indirect-exports"
|
||||
" mod_0))))"
|
||||
"(let-values(((temp59_0)"
|
||||
"(lambda(m_0)"
|
||||
"(begin"
|
||||
" 'temp59"
|
||||
"(variables->api-nonprovides(module-provides m_0)((module-get-all-variables m_0))))))"
|
||||
"((temp60_0) 'module->indirect-exports)"
|
||||
"((mod61_0) mod_0))"
|
||||
"(module->11.1 unsafe-undefined temp59_0 temp60_0 mod61_0 #f)))))"
|
||||
"(define-values"
|
||||
"(1/module-provide-protected?)"
|
||||
"(lambda(mod_0 sym_0)"
|
||||
"(begin"
|
||||
" 'module-provide-protected?"
|
||||
"(module->"
|
||||
"(let-values(((temp62_0)"
|
||||
"(lambda(m_0)"
|
||||
"(begin"
|
||||
" 'temp62"
|
||||
"(let-values(((b/p_0)(hash-ref(module-provides m_0) sym_0 #f)))"
|
||||
"(let-values(((or-part_0)(not b/p_0)))(if or-part_0 or-part_0(provided-as-protected? b/p_0)))))"
|
||||
" 'module-provide-protected?"
|
||||
" mod_0))))"
|
||||
"(let-values(((or-part_0)(not b/p_0)))"
|
||||
"(if or-part_0 or-part_0(provided-as-protected? b/p_0)))))))"
|
||||
"((temp63_0) 'module-provide-protected?)"
|
||||
"((mod64_0) mod_0))"
|
||||
"(module->11.1 unsafe-undefined temp62_0 temp63_0 mod64_0 #f)))))"
|
||||
"(define-values"
|
||||
"(1/module->namespace)"
|
||||
"(let-values(((module->namespace17_0)"
|
||||
"(lambda(mod16_0 ns15_0)"
|
||||
"(let-values(((module->namespace24_0)"
|
||||
"(lambda(mod23_0 ns22_0)"
|
||||
"(begin"
|
||||
" 'module->namespace17"
|
||||
"(let-values(((mod_0) mod16_0))"
|
||||
"(let-values(((ns_0)(if(eq? ns15_0 unsafe-undefined)(1/current-namespace) ns15_0)))"
|
||||
" 'module->namespace24"
|
||||
"(let-values(((mod_0) mod23_0))"
|
||||
"(let-values(((ns_0)(if(eq? ns22_0 unsafe-undefined)(1/current-namespace) ns22_0)))"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
|
|
@ -61748,20 +61849,20 @@ static const char *startup_source =
|
|||
" (raise-argument-error 'module->namespace \"namespace?\" ns_0)))"
|
||||
"(values))))"
|
||||
"(let-values(((name_0)"
|
||||
"(let-values(((mod44_0) mod_0)((temp45_0) #t))"
|
||||
"(reference->resolved-module-path27.1 temp45_0 mod44_0))))"
|
||||
"(let-values(((mod69_0) mod_0)((temp70_0) #t))"
|
||||
"(reference->resolved-module-path34.1 temp70_0 mod69_0))))"
|
||||
"(let-values(((phase_0)(namespace-phase ns_0)))"
|
||||
"(let-values(((m-ns_0)"
|
||||
"(let-values(((ns46_0) ns_0)"
|
||||
"((name47_0) name_0)"
|
||||
"((phase48_0) phase_0))"
|
||||
"(let-values(((ns71_0) ns_0)"
|
||||
"((name72_0) name_0)"
|
||||
"((phase73_0) phase_0))"
|
||||
"(namespace->module-namespace82.1"
|
||||
" #f"
|
||||
" #f"
|
||||
" unsafe-undefined"
|
||||
" ns46_0"
|
||||
" name47_0"
|
||||
" phase48_0))))"
|
||||
" ns71_0"
|
||||
" name72_0"
|
||||
" phase73_0))))"
|
||||
"(begin"
|
||||
"(if m-ns_0"
|
||||
"(void)"
|
||||
|
|
@ -61788,34 +61889,34 @@ static const char *startup_source =
|
|||
"(let-values()"
|
||||
"(namespace-set-root-expand-ctx!"
|
||||
" m-ns_0"
|
||||
"(let-values(((temp49_0)(namespace-mpi m-ns_0)))"
|
||||
"(let-values(((temp74_0)(namespace-mpi m-ns_0)))"
|
||||
"(make-root-expand-context13.1"
|
||||
" #f"
|
||||
" null"
|
||||
" unsafe-undefined"
|
||||
" unsafe-undefined"
|
||||
" temp49_0)))))"
|
||||
"(let-values(((ns41_0) ns_0)"
|
||||
"((temp42_0)(namespace-mpi m-ns_0))"
|
||||
"((phase43_0) phase_0))"
|
||||
" temp74_0)))))"
|
||||
"(let-values(((ns66_0) ns_0)"
|
||||
"((temp67_0)(namespace-mpi m-ns_0))"
|
||||
"((phase68_0) phase_0))"
|
||||
"(namespace-module-make-available!112.1"
|
||||
" unsafe-undefined"
|
||||
" ns41_0"
|
||||
" temp42_0"
|
||||
" phase43_0))"
|
||||
" ns66_0"
|
||||
" temp67_0"
|
||||
" phase68_0))"
|
||||
" m-ns_0)))))))))))))))"
|
||||
"(case-lambda"
|
||||
"((mod_0)(begin 'module->namespace(module->namespace17_0 mod_0 unsafe-undefined)))"
|
||||
"((mod_0 ns15_0)(module->namespace17_0 mod_0 ns15_0)))))"
|
||||
"((mod_0)(begin 'module->namespace(module->namespace24_0 mod_0 unsafe-undefined)))"
|
||||
"((mod_0 ns22_0)(module->namespace24_0 mod_0 ns22_0)))))"
|
||||
"(define-values"
|
||||
"(1/namespace-unprotect-module)"
|
||||
"(let-values(((namespace-unprotect-module22_0)"
|
||||
"(lambda(insp20_0 mod21_0 ns19_0)"
|
||||
"(let-values(((namespace-unprotect-module29_0)"
|
||||
"(lambda(insp27_0 mod28_0 ns26_0)"
|
||||
"(begin"
|
||||
" 'namespace-unprotect-module22"
|
||||
"(let-values(((insp_0) insp20_0))"
|
||||
"(let-values(((mod_0) mod21_0))"
|
||||
"(let-values(((ns_0)(if(eq? ns19_0 unsafe-undefined)(1/current-namespace) ns19_0)))"
|
||||
" 'namespace-unprotect-module29"
|
||||
"(let-values(((insp_0) insp27_0))"
|
||||
"(let-values(((mod_0) mod28_0))"
|
||||
"(let-values(((ns_0)(if(eq? ns26_0 unsafe-undefined)(1/current-namespace) ns26_0)))"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
"(let-values()"
|
||||
|
|
@ -61850,20 +61951,20 @@ static const char *startup_source =
|
|||
" ns_0)))"
|
||||
"(values))))"
|
||||
"(let-values(((name_0)"
|
||||
"(let-values(((mod51_0) mod_0)((temp52_0) #f))"
|
||||
"(reference->resolved-module-path27.1 temp52_0 mod51_0))))"
|
||||
"(let-values(((mod76_0) mod_0)((temp77_0) #f))"
|
||||
"(reference->resolved-module-path34.1 temp77_0 mod76_0))))"
|
||||
"(let-values(((phase_0)(namespace-phase ns_0)))"
|
||||
"(let-values(((m-ns_0)"
|
||||
"(let-values(((ns53_0) ns_0)"
|
||||
"((name54_0) name_0)"
|
||||
"((phase55_0) phase_0))"
|
||||
"(let-values(((ns78_0) ns_0)"
|
||||
"((name79_0) name_0)"
|
||||
"((phase80_0) phase_0))"
|
||||
"(namespace->module-namespace82.1"
|
||||
" #f"
|
||||
" #f"
|
||||
" unsafe-undefined"
|
||||
" ns53_0"
|
||||
" name54_0"
|
||||
" phase55_0))))"
|
||||
" ns78_0"
|
||||
" name79_0"
|
||||
" phase80_0))))"
|
||||
"(begin"
|
||||
"(if m-ns_0"
|
||||
"(void)"
|
||||
|
|
@ -61880,8 +61981,8 @@ static const char *startup_source =
|
|||
"(make-inspector(current-code-inspector))))"
|
||||
"(void)))))))))))))))))))"
|
||||
"(case-lambda"
|
||||
"((insp_0 mod_0)(begin 'namespace-unprotect-module(namespace-unprotect-module22_0 insp_0 mod_0 unsafe-undefined)))"
|
||||
"((insp_0 mod_0 ns19_0)(namespace-unprotect-module22_0 insp_0 mod_0 ns19_0)))))"
|
||||
"((insp_0 mod_0)(begin 'namespace-unprotect-module(namespace-unprotect-module29_0 insp_0 mod_0 unsafe-undefined)))"
|
||||
"((insp_0 mod_0 ns26_0)(namespace-unprotect-module29_0 insp_0 mod_0 ns26_0)))))"
|
||||
"(define-values"
|
||||
"(namespace->module/complain)"
|
||||
"(lambda(who_0 ns_0 name_0)"
|
||||
|
|
@ -61901,12 +62002,12 @@ static const char *startup_source =
|
|||
"(if or-part_1 or-part_1(1/resolved-module-path? mod_0))))))))"
|
||||
" (define-values (module-reference-str) \"(or/c module-path? module-path-index? resolved-module-path?)\")"
|
||||
"(define-values"
|
||||
"(reference->resolved-module-path27.1)"
|
||||
"(lambda(load?24_0 mod26_0)"
|
||||
"(reference->resolved-module-path34.1)"
|
||||
"(lambda(load?31_0 mod33_0)"
|
||||
"(begin"
|
||||
" 'reference->resolved-module-path27"
|
||||
"(let-values(((mod_0) mod26_0))"
|
||||
"(let-values(((load?_0) load?24_0))"
|
||||
" 'reference->resolved-module-path34"
|
||||
"(let-values(((mod_0) mod33_0))"
|
||||
"(let-values(((load?_0) load?31_0))"
|
||||
"(let-values()"
|
||||
"(if(1/resolved-module-path? mod_0)"
|
||||
"(let-values() mod_0)"
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user