suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Merge branch 'genid' of github.com:mflatt/ChezScheme

Browse Source 
original commit: bd3c746343c6850ed62eb5fcd2674292e4480fa4
This commit is contained in:
Matthew Flatt 2018-01-04 18:47:47 -07:00
commit f4f0bfff11
21 changed files with 290 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
LOG
View File

@ -798,5 +798,12 @@
5_5.ms
- fix a few signatures
primdata.ss
- fix comment about Sscheme_program
main.c
- fix even? and odd? to error on exceptional flonums
5_3.ss, 5_3.ms, fl.ms, root-experr*, patch*
- fix bug in date->time-utc caused by incorrect use of difftime in Windows
stats.c, date.ms, release_notes.stex
- add current-generate-id and expand-omit-library-invocations, which can be
useful for avoiding library recompilation and redundant invocation checks
syntax.ss, record.ss, primdata.ss, misc.ms, system.stex

2
c/main.c
View File

@ -333,7 +333,7 @@ int main(int argc, const char *argv[]) {
/* Sscheme_script invokes the value of the scheme-script parameter */
status = Sscheme_script(scriptfile, new_argc, argv);
else if (programfile != (char *)0)
/* Sscheme_script invokes the value of the scheme-script parameter */
/* Sscheme_program invokes the value of the scheme-program parameter */
status = Sscheme_program(programfile, new_argc, argv);
else {
/* Sscheme_start invokes the value of the scheme-start parameter */

2
c/stats.c
View File

@ -409,7 +409,7 @@ ptr S_mktime(ptr dtvec) {
tzoff = adjust_time_zone(dtvec, &tmx, given_tzoff);
if (tzoff != orig_tzoff) tx = (time_t) difftime(tx, (time_t)(orig_tzoff - tzoff));
if (tzoff != orig_tzoff) tx = tx - orig_tzoff + tzoff;
return Scons(S_integer_time_t(tx), Svector_ref(dtvec, dtvec_nsec));
}

12
c/vs.bat
View File

@ -1,22 +1,26 @@
@echo off
set Applications=%ProgramFiles(x86)%
if not "%Applications%" == "" goto win64
set Applications=%ProgramFiles%
:win64
:: Set up Visual Studio command line environment variables given a
:: machine type, e.g., amd64 or x86.
:: Visual Studio 2017 Enterprise
set BATDIR=%ProgramFiles(x86)%\Microsoft Visual Studio\2017\Enterprise\VC\Auxiliary\Build
set BATDIR=%Applications%\Microsoft Visual Studio\2017\Enterprise\VC\Auxiliary\Build
if exist "%BATDIR%\vcvarsall.bat" goto found
:: Visual Studio 2017 Professional
set BATDIR=%ProgramFiles(x86)%\Microsoft Visual Studio\2017\Professional\VC\Auxiliary\Build
set BATDIR=%Applications%\Microsoft Visual Studio\2017\Professional\VC\Auxiliary\Build
if exist "%BATDIR%\vcvarsall.bat" goto found
:: Visual Studio 2017 Community
set BATDIR=%ProgramFiles(x86)%\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build
set BATDIR=%Applications%\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build
if exist "%BATDIR%\vcvarsall.bat" goto found
:: Visual Studio 2017 BuildTools
set BATDIR=%ProgramFiles(x86)%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build
set BATDIR=%Applications%\Microsoft Visual Studio\2017\BuildTools\VC\Auxiliary\Build
if exist "%BATDIR%\vcvarsall.bat" goto found
:: Visual Studio 2015

130
csug/system.stex
View File

@ -2120,6 +2120,136 @@ loaded from source, when it is compiled via \scheme{compile-file},
and when a compiled version of the file is loaded via \scheme{load}
or \scheme{visit}.
%----------------------------------------------------------------------------
\entryheader
\formdef{current-generate-id}{\categorythreadparameter}{current-generate-id}
\listlibraries
\endentryheader
\noindent
This parameter determines a procedure that is called by the macro
expander. The procedure receives a symbol and returns a fresh symbol
that the expander uses for a top-level binding, as a record uid,
or to identify a library compilation. The default procedure converts the
symbol to a string and passes it to \scheme{gensym}.
For example, while expanding the following \scheme{library}, the
\scheme{current-generate-id} procedure is called on the symbols
\scheme{a-lib}, \scheme{a-var}, and \scheme{a-var} again.
\schemedisplay
(library (a-lib)
(export a-var)
(import (chezscheme))
(define a-var 3)
(define-syntax def
(syntax-rules ()
[(_) (define a-var 'other)]))
(def))
\endschemedisplay
The \scheme{current-generate-id} procedure is called on \scheme{a-lib}
to generate a symbol that identifies this particular library
compilation, as opposed to the compilation of a different library
named \scheme{(a-lib)}. It is called on \scheme{a-var} the first time
to select a distinct symbol to hold the value of the \scheme{a-var}
defininion, since \scheme{a-var} itself should not be defined directly
at the top level. Finally, the \scheme{current-generate-id} procedure
is called on \scheme{a-var} to select a name for the macro-introduced
definiton of \scheme{a-var} in the expansion of \scheme{(def)}---which
turns out to be completely inaccessible since no reference is
introduced by the same expansion step.
Setting the parameter to a particular, deterministic generator can
cause symbols in the expansion of the library to be always the
same. That determinism can be helpful if the expansion semantically
matches an earlier expansion, so that uses of an earlier compilation
remain compatible with the new one. Of course, reusing a symbol runs
the risk of creating collisions that the macro and library system
normally prevents via distinct symbols, and compiler optimizations may
rely on the expectation of distinct symbols for distinct compilations.
Configure \scheme{current-generate-id} at your own risk.
As a further example, suppose that the following two forms are
compiled separately:
\schemedisplay
;; Compile this x.ss to x.so
(library (x)
(export x)
(import (chezscheme))
(define x '(x)))
;; Compile this y.ss to y.so
(top-level-program
(import (chezscheme)
(y))
(printf "~s\n" x))
\endschemedisplay
If \scheme{x.ss} is modified and recompiled, loading the new
\scheme{x.so} and the old \scheme{y.so} will correctly report an error
that the compiled \scheme{y.so} requires a different compilation
instance that the one already loaded.
Suppose, however, that you're willing to live dangerously to avoid
recompiling \scheme{y.ss} by generating the same symbols for every
compilation of \scheme{x.ss}. While compiling \scheme{x.ss}, you could
set \scheme{current-generate-id} to the result of
\scheme{make-x-generator}:
\schemedisplay
(define (make-x-generator)
(let ([x-uid "gf91a5b83ujz3mogjdaij7-x"]
[counter-ht (make-eq-hashtable)])
(lambda (sym)
(let* ([n (eq-hashtable-ref counter-ht sym 0)]
[s ((if (gensym? sym) gensym->unique-string symbol->string) sym)]
[g (gensym (symbol->string sym) (format "~a-~a-~a" x-uid s n))])
(eq-hashtable-set! counter-ht sym (+ n 1))
g))))
\endschemedisplay
As long as the first and second compilations of \scheme{x.ss} use the
result of \scheme{make-x-generator}, the first compilation of
\scheme{y.ss} might work with the second compilation of \scheme{x.ss},
even if the change adds, removes, or reorders definitions of variables
other than \scheme{x}.
Beware that if the variable \scheme{x} is originally defined as
\scheme{(define x 1)}, then the compilation of \scheme{y.ss} likely
inlines the value \scheme{1} in place of its reference to the variable
\scheme{x}, so changing \scheme{x.ss} will have no effect without
recompiling \scheme{y.ss}. Similarly, if the change to \scheme{x.ss}
deletes the definition of \scheme{x} or introduces a macro-generated
definition of \scheme{x} before the direct definition, then the
previously compiled \scheme{y.ss} is unlikely to refer to the correct
definition of \scheme{x} in the new compilation of \scheme{x.ss}.
Configure \scheme{make-x-generator} this way only in situations where
the potential for unspecified failure is more tolerable than
recompilation.
%----------------------------------------------------------------------------
\entryheader
\formdef{expand-omit-library-invocations}{\categorythreadparameter}{expand-omit-library-invocations}
\listlibraries
\endentryheader
\noindent
This boolean-valued parameter determines whether library uses are
recorded in macro expansion. Normally, when an expression expands to a
reference to a library-defined identifier, the expansion is prefixed
with a check to ensure that the exporting library is defined and
invoked. If \scheme{expand-omit-library-invocations} is set to true,
the prefix is omitted.
Setting \scheme{expand-omit-library-invocations} to true makes sense
only when evaluating many small expressions in a context where all
referenced libraries are known to be present and already invoked, and
only when it's worth saving the small overhead of representing and
running the check.
\section{Source Directories and Files\label{SECTSYSTEMSOURCE}}
%----------------------------------------------------------------------------

8
mats/date.ms
View File

@ -622,9 +622,11 @@
(sleep (make-time 'time-duration 0 1))
(time<? t (date->time-utc (current-date))))
(let ([t (current-time)])
(time=?
(date->time-utc (time-utc->date t -14400))
(date->time-utc (time-utc->date t 0))))
(and
(time=? (date->time-utc (time-utc->date t)) t)
(time=? (date->time-utc (time-utc->date t -86400)) t)
(time=? (date->time-utc (time-utc->date t 0)) t)
(time=? (date->time-utc (time-utc->date t 86400)) t)))
)
(mat time&date-printing

68
mats/misc.ms
View File

@ -5072,3 +5072,71 @@
(mutable-bytevector? '#vu8())
)
(mat current-generate-id
(begin
(define (make-x-generator)
(let ([x-uid "gf91a5b83ujz3mogjdaij7-x"]
[counter-ht (make-eq-hashtable)])
(lambda (sym)
(let* ([n (eq-hashtable-ref counter-ht sym 0)]
[str (if (gensym? sym) (gensym->unique-string sym) (symbol->string sym))]
[g (gensym (symbol->string sym) (format "~a-~a-~a" x-uid str n))])
(eq-hashtable-set! counter-ht sym (+ n 1))
g))))
(and (parameterize ([current-generate-id (make-x-generator)])
(eval `(module consistent-x (x make-pt pt-r)
;; Note: `module` doesn't currently enable `x` to be inlined
(define x 1)
(define-record-type pt (fields r i)))))
#t))
(begin
(define return-x (let ()
(import consistent-x)
(lambda () x)))
(define a-pt (let ()
(import consistent-x)
(make-pt -1 -2)))
(define get-r (let ()
(import consistent-x)
(lambda (p) (pt-r p))))
(equal? 1 (return-x)))
(equal? -1 (get-r a-pt))
(begin
(parameterize ([current-generate-id (make-x-generator)])
(eval `(module consistent-x (x make-pt pt-x)
(define x 2)
(define-record-type pt (fields x y)))))
(equal? 2 (return-x)))
(equal? -1 (get-r a-pt))
(begin
(parameterize ([current-generate-id (make-x-generator)])
(eval `(module consistent-x (x)
(define x 3)
(define-syntax def (syntax-rules () [(_) (define x 'other)]))
;; `(def)` after above definition => expect that
;; its `x` is generated second
(def))))
(equal? 3 (return-x)))
)
(mat expand-omit-library-invocations
(not (expand-omit-library-invocations))
(begin
(library (define-m-as-one) (export m) (import (chezscheme)) (define m 1))
(define (find-define-m-as-one s)
(or (eq? s 'define-m-as-one)
(and (pair? s)
(or (find-define-m-as-one (car s))
(find-define-m-as-one (cdr s))))))
#t)
(find-define-m-as-one (expand '(let () (import (define-m-as-one)) m)))
(begin
(expand-omit-library-invocations 'yes)
(eq? #t (expand-omit-library-invocations)))
(not (find-define-m-as-one (expand '(let () (import (define-m-as-one)) m))))
(begin
(expand-omit-library-invocations #f)
(not (expand-omit-library-invocations)))
(find-define-m-as-one (expand '(let () (import (define-m-as-one)) m)))
)

4
mats/patch-compile-0-f-t-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-f-f 2017-12-28 06:34:44.000000000 -0600
--- errors-compile-0-f-t-f 2017-12-28 05:58:00.000000000 -0600
*** errors-compile-0-f-f-f 2017-12-28 15:38:17.000000000 -0600
--- errors-compile-0-f-t-f 2017-12-28 14:53:31.000000000 -0600
***************
*** 125,131 ****
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".

8
mats/patch-compile-0-t-f-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-f-f 2017-12-28 06:34:44.000000000 -0600
--- errors-compile-0-t-f-f 2017-12-28 06:06:29.000000000 -0600
*** errors-compile-0-f-f-f 2017-12-28 15:38:17.000000000 -0600
--- errors-compile-0-t-f-f 2017-12-28 15:10:14.000000000 -0600
***************
*** 93,99 ****
3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".
@ -5659,7 +5659,7 @@
! fl.mo:Expected error in mat flodd?: "incorrect argument count in call (flodd? 0.0 1.0)".
fl.mo:Expected error in mat flodd?: "flodd?: a is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: 3 is not a flonum".
fl.mo:Expected error in mat flodd?: "odd?: 3.2 is not an integer".
fl.mo:Expected error in mat flodd?: "flodd?: 3.2 is not an integer".
--- 9191,9198 ----
fl.mo:Expected error in mat fleven?: "fleven?: 1+1i is not a flonum".
fl.mo:Expected error in mat fleven?: "fleven?: +inf.0 is not an integer".
@ -5668,7 +5668,7 @@
! fl.mo:Expected error in mat flodd?: "incorrect number of arguments to #<procedure flodd?>".
fl.mo:Expected error in mat flodd?: "flodd?: a is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: 3 is not a flonum".
fl.mo:Expected error in mat flodd?: "odd?: 3.2 is not an integer".
fl.mo:Expected error in mat flodd?: "flodd?: 3.2 is not an integer".
***************
*** 9200,9206 ****
fl.mo:Expected error in mat flodd?: "flodd?: 3+1i is not a flonum".

4
mats/patch-interpret-0-f-f-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-f-f 2017-12-28 06:34:44.000000000 -0600
--- errors-interpret-0-f-f-f 2017-12-28 06:15:19.000000000 -0600
*** errors-compile-0-f-f-f 2017-12-28 15:38:17.000000000 -0600
--- errors-interpret-0-f-f-f 2017-12-28 15:18:48.000000000 -0600
***************
*** 1,7 ****
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".

4
mats/patch-interpret-0-f-t-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-t-f 2017-12-28 05:58:00.000000000 -0600
--- errors-interpret-0-f-t-f 2017-12-28 06:24:06.000000000 -0600
*** errors-compile-0-f-t-f 2017-12-28 14:53:31.000000000 -0600
--- errors-interpret-0-f-t-f 2017-12-28 15:27:32.000000000 -0600
***************
*** 1,7 ****
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".

4
mats/patch-interpret-3-f-f-f
View File

@ -1,5 +1,5 @@
*** errors-compile-3-f-f-f 2017-12-28 05:53:47.000000000 -0600
--- errors-interpret-3-f-f-f 2017-12-28 06:41:08.000000000 -0600
*** errors-compile-3-f-f-f 2017-12-28 14:49:22.000000000 -0600
--- errors-interpret-3-f-f-f 2017-12-28 15:45:02.000000000 -0600
***************
*** 1,3 ****
--- 1,9 ----

4
mats/patch-interpret-3-f-t-f
View File

@ -1,5 +1,5 @@
*** errors-compile-3-f-t-f 2017-12-28 06:02:02.000000000 -0600
--- errors-interpret-3-f-t-f 2017-12-28 06:28:19.000000000 -0600
*** errors-compile-3-f-t-f 2017-12-28 15:05:52.000000000 -0600
--- errors-interpret-3-f-t-f 2017-12-28 15:31:52.000000000 -0600
***************
*** 1,3 ****
--- 1,9 ----

2
mats/root-experr-compile-0-f-f-f
View File

@ -9228,7 +9228,7 @@ fl.mo:Expected error in mat flodd?: "incorrect argument count in call (flodd?)".
fl.mo:Expected error in mat flodd?: "incorrect argument count in call (flodd? 0.0 1.0)".
fl.mo:Expected error in mat flodd?: "flodd?: a is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: 3 is not a flonum".
fl.mo:Expected error in mat flodd?: "odd?: 3.2 is not an integer".
fl.mo:Expected error in mat flodd?: "flodd?: 3.2 is not an integer".
fl.mo:Expected error in mat flodd?: "flodd?: 3.0+1.0i is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: 3+1i is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: +inf.0 is not an integer".

2
mats/root-experr-compile-2-f-f-f
View File

@ -9228,7 +9228,7 @@ fl.mo:Expected error in mat flodd?: "incorrect argument count in call (flodd?)".
fl.mo:Expected error in mat flodd?: "incorrect argument count in call (flodd? 0.0 1.0)".
fl.mo:Expected error in mat flodd?: "flodd?: a is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: 3 is not a flonum".
fl.mo:Expected error in mat flodd?: "odd?: 3.2 is not an integer".
fl.mo:Expected error in mat flodd?: "flodd?: 3.2 is not an integer".
fl.mo:Expected error in mat flodd?: "flodd?: 3.0+1.0i is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: 3+1i is not a flonum".
fl.mo:Expected error in mat flodd?: "flodd?: +inf.0 is not an integer".

8
release_notes/release_notes.stex
View File

@ -1583,6 +1583,14 @@ in fasl files does not generally make sense.
%-----------------------------------------------------------------------------
\section{Bug Fixes}\label{section:bugfixes}
\subsection{Incorrect handling of offset in
\protect\scheme{date->time-utc} on Windows (9.5)}
A bug when \scheme{date->time-utc} is called on Windows with a
date-zone-offset smaller than the system's time-zone offset has been
fixed.
[This bug dated back to Version 9.5.]
\subsection{Compiler mishandling of fx /carry operations (9.5)}
A bug in the source optimizer that caused an internal compiler error when

24
s/5_3.ss
View File

@ -1890,36 +1890,36 @@
(when (= y 0) (domain-error 'remainder y))
(f x y)]))))
(set! even?
(set-who! even?
(lambda (x)
(type-case x
[(fixnum?) (fxeven? x)]
[(bignum?) (not (bigodd? x))]
[(flonum?)
(when (exceptional-flonum? x) (noninteger-error 'even? x))
(when (exceptional-flonum? x) (noninteger-error who x))
(let ([y (fl* ($flfloor (fl/ x 2.0)) 2.0)])
(cond
[(fl= x y) #t]
[(fl= (fl+ y 1.0) x) #f]
[else (noninteger-error 'even? x)]))]
[else (noninteger-error who x)]))]
[else
(unless (integer? x) (noninteger-error 'even? x))
(unless (integer? x) (noninteger-error who x))
(even? (real-part x))])))
(set! odd?
(set-who! odd?
(lambda (x)
(type-case x
[(fixnum?) (fxodd? x)]
[(bignum?) (bigodd? x)]
[(flonum?)
(when (exceptional-flonum? x) (noninteger-error 'odd? x))
(when (exceptional-flonum? x) (noninteger-error who x))
(let ([y (fl* ($flfloor (fl/ x 2.0)) 2.0)])
(cond
[(fl= x y) #f]
[(fl= (fl+ y 1.0) x) #t]
[else (noninteger-error 'odd? x)]))]
[else (noninteger-error who x)]))]
[else
(unless (integer? x) (noninteger-error 'odd? x))
(unless (integer? x) (noninteger-error who x))
(odd? (real-part x))])))
(set-who! round
@ -2657,22 +2657,22 @@
(set-who! fleven?
(lambda (x)
(unless (flonum? x) ($oops who "~s is not a flonum" x))
(when (exceptional-flonum? x) (noninteger-error 'fleven? x))
(when (exceptional-flonum? x) (noninteger-error who x))
(let ([y (fl* ($flfloor (fl/ x 2.0)) 2.0)])
(cond
[(fl= x y) #t]
[(fl= (fl+ y 1.0) x) #f]
[else (noninteger-error 'fleven? x)]))))
[else (noninteger-error who x)]))))
(set-who! flodd?
(lambda (x)
(unless (flonum? x) ($oops who "~s is not a flonum" x))
(when (exceptional-flonum? x) (noninteger-error 'flodd? x))
(when (exceptional-flonum? x) (noninteger-error who x))
(let ([y (fl* ($flfloor (fl/ x 2.0)) 2.0)])
(cond
[(fl= x y) #f]
[(fl= (fl+ y 1.0) x) #t]
[else (noninteger-error 'odd? x)]))))
[else (noninteger-error who x)]))))
(set-who! flmin
(let ([$flmin (lambda (x y) (if (or (fl< x y) ($nan? x)) x y))])

2
s/primdata.ss
View File

@ -935,6 +935,7 @@
(current-eval [sig [() -> (procedure)] [(procedure) -> (void)]] [flags])
(current-exception-state [sig [() -> (exception-state)] [(exception-state) -> (void)]] [flags])
(current-expand [sig [() -> (procedure)] [(procedure) -> (void)]] [flags])
(current-generate-id [sig [() -> (procedure)] [(procedure) -> (void)]] [flags])
(current-input-port [sig [() -> (textual-input-port)] [(textual-input-port) -> (void)]] [flags]) ; not restricted to 1 argument
(current-locate-source-object-source [sig [() -> (procedure)] [(procedure) -> (void)]] [flags])
(current-make-source-object [sig [() -> (procedure)] [(procedure) -> (void)]] [flags])
@ -947,6 +948,7 @@
(enable-object-backreferences [sig [() -> (boolean)] [(ptr) -> (void)]] [flags])
(enable-object-counts [sig [() -> (boolean)] [(ptr) -> (void)]] [flags])
(eval-syntax-expanders-when [sig [() -> (list)] [(sub-list) -> (void)]] [flags])
(expand-omit-library-invocations [sig [() -> (boolean)] [(ptr) -> (void)]] [flags])
(expand-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags])
(expand/optimize-output [sig [() -> (maybe-textual-output-port)] [(maybe-textual-output-port) -> (void)]] [flags])
(exit-handler [sig [() -> (procedure)] [(procedure) -> (void)]] [flags])

11
s/record.ss
View File

@ -395,6 +395,15 @@
(rec predicate (lambda (x) ($sealed-record? x rtd)))
(rec predicate (lambda (x) (record? x rtd))))))
(set-who! current-generate-id
($make-thread-parameter
(lambda (sym)
(unless (symbol? sym) ($oops 'default-generate-id "~s is not a symbol" sym))
(gensym (symbol->string sym)))
(lambda (p)
(unless (procedure? p) ($oops who "~s is not a procedure" p))
p)))
(let ((base-rtd #!base-rtd))
(define (make-flags uid sealed? opaque? parent)
(fxlogor
@ -408,7 +417,7 @@
(when (and parent (record-type-sealed? parent))
($oops who "cannot extend sealed record type ~s" parent))
(let ([parent-fields (if (not parent) '() (csv7:record-type-field-decls parent))]
[uid (or uid (gensym (symbol->string name)))])
[uid (or uid ((current-generate-id) name))])
; start base offset at rtd field
; synchronize with syntax.ss and front.ss
(let-values ([(pm mpm flds size)

13
s/syntax.ss
View File

@ -469,7 +469,7 @@
(define generate-id
(lambda (sym)
(gensym (symbol->string sym))))
((current-generate-id) sym)))
(define make-token:sym
(lambda (token sym)
@ -3424,7 +3424,12 @@
(define residualize-invoke-requirements
(case-lambda
[(code) (residualize-invoke-requirements '() (require-visit) (require-invoke) code)]
[(code) (residualize-invoke-requirements '()
(require-visit)
(if (expand-omit-library-invocations)
'()
(require-invoke))
code)]
[(import* visit* invoke* code)
(build-sequence no-source
`(,@(map (build-requirement '$import-library) import*)
@ -4965,6 +4970,10 @@
(lambda ()
(list-loaded-libraries)))
(set! expand-omit-library-invocations
($make-thread-parameter #f
(lambda (v) (and v #t))))
(let ()
(define maybe-get-lib
(lambda (who libref)

24
wininstall/locate-vcredist.bat
View File

@ -8,20 +8,18 @@
)
@IF "%VisualStudioVersion%"=="15.0" (
@IF EXIST "%VCINSTALLDIR%Redist\MSVC\14.10.25008" (
@SET "Path32=%VCINSTALLDIR%Redist\MSVC\14.10.25008\MergeModules\Microsoft_VC150_CRT_x86.msm"
@SET "Path64=%VCINSTALLDIR%Redist\MSVC\14.10.25008\MergeModules\Microsoft_VC150_CRT_x64.msm"
)
@IF EXIST "%VCINSTALLDIR%Redist\MSVC\14.11.25325" (
@SET "Path32=%VCINSTALLDIR%Redist\MSVC\14.11.25325\MergeModules\Microsoft_VC141_CRT_x86.msm"
@SET "Path64=%VCINSTALLDIR%Redist\MSVC\14.11.25325\MergeModules\Microsoft_VC141_CRT_x64.msm"
)
@IF EXIST "%VCINSTALLDIR%Redist\MSVC\14.12.25810" (
@SET "Path32=%VCINSTALLDIR%Redist\MSVC\14.12.25810\MergeModules\Microsoft_VC141_CRT_x86.msm"
@SET "Path64=%VCINSTALLDIR%Redist\MSVC\14.12.25810\MergeModules\Microsoft_VC141_CRT_x64.msm"
@PUSHD "%VCINSTALLDIR%Redist\MSVC"
@FOR /D %%D IN (*) DO (
@PUSHD %%D
@FOR %%F IN (MergeModules\Microsoft_VC*_CRT_x86.msm) DO (
SET "Path32=%VCINSTALLDIR%Redist\MSVC\%%D\%%F"
)
@FOR %%F IN (MergeModules\Microsoft_VC*_CRT_x64.msm) DO (
SET "Path64=%VCINSTALLDIR%Redist\MSVC\%%D\%%F"
)
@POPD
)
@POPD
)
@DEL vcredist.wxs >nul 2>&1