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

original commit: bd3c746343c6850ed62eb5fcd2674292e4480fa4

LOG

@@ -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

c/main.c

@@ -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 */

c/stats.c

@@ -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));
 }

c/vs.bat

@@ -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

csug/system.stex

@@ -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}}
 
 %----------------------------------------------------------------------------

mats/date.ms

@@ -622,9 +622,11 @@
     (sleep (make-time 'time-duration 0 1))
     (time<? t (date->time-utc (current-date))))
   (let ([t (current-time)])
-    (time=?
+    (and
-      (date->time-utc (time-utc->date t -14400))
+     (time=? (date->time-utc (time-utc->date t)) t)
-      (date->time-utc (time-utc->date t 0))))
+     (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

mats/misc.ms

@@ -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)))
+  )

mats/patch-compile-0-f-t-f

@@ -1,5 +1,5 @@
-*** errors-compile-0-f-f-f	2017-12-28 06:34:44.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 05:58:00.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".

mats/patch-compile-0-t-f-f

@@ -1,5 +1,5 @@
-*** errors-compile-0-f-f-f	2017-12-28 06:34:44.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 06:06:29.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".

mats/patch-interpret-0-f-f-f

@@ -1,5 +1,5 @@
-*** errors-compile-0-f-f-f	2017-12-28 06:34:44.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 06:15:19.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".

mats/patch-interpret-0-f-t-f

@@ -1,5 +1,5 @@
-*** errors-compile-0-f-t-f	2017-12-28 05:58:00.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 06:24:06.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".

mats/patch-interpret-3-f-f-f

@@ -1,5 +1,5 @@
-*** errors-compile-3-f-f-f	2017-12-28 05:53:47.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 06:41:08.000000000 -0600
+--- errors-interpret-3-f-f-f	2017-12-28 15:45:02.000000000 -0600
 ***************
 *** 1,3 ****
 --- 1,9 ----

mats/patch-interpret-3-f-t-f

@@ -1,5 +1,5 @@
-*** errors-compile-3-f-t-f	2017-12-28 06:02:02.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 06:28:19.000000000 -0600
+--- errors-interpret-3-f-t-f	2017-12-28 15:31:52.000000000 -0600
 ***************
 *** 1,3 ****
 --- 1,9 ----

mats/root-experr-compile-0-f-f-f

@@ -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".

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

@@ -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".

release_notes/release_notes.stex

@@ -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

s/5_3.ss

@@ -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))])

s/primdata.ss

@@ -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])

s/record.ss

@@ -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)

s/syntax.ss

@@ -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)

wininstall/locate-vcredist.bat

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