diff --git a/LOG b/LOG index e4ce1947ae..d55561292b 100644 --- a/LOG +++ b/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 diff --git a/c/main.c b/c/main.c index ba9be6d5a3..8e697178bf 100644 --- a/c/main.c +++ b/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 */ diff --git a/c/stats.c b/c/stats.c index 820db2ace9..0e0eb6c8af 100644 --- a/c/stats.c +++ b/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)); } diff --git a/c/vs.bat b/c/vs.bat index 3301d1cffa..7a1d2c45d0 100644 --- a/c/vs.bat +++ b/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 diff --git a/csug/system.stex b/csug/system.stex index 7880aee84d..718c8fda56 100644 --- a/csug/system.stex +++ b/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}} %---------------------------------------------------------------------------- diff --git a/mats/date.ms b/mats/date.ms index bcadbe39c0..72c2f464f2 100644 --- a/mats/date.ms +++ b/mats/date.ms @@ -622,9 +622,11 @@ (sleep (make-time 'time-duration 0 1)) (timetime-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 diff --git a/mats/misc.ms b/mats/misc.ms index 7a2a1261f9..43b10f8b5b 100644 --- a/mats/misc.ms +++ b/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))) + ) diff --git a/mats/patch-compile-0-f-t-f b/mats/patch-compile-0-f-t-f index 847376c22a..406879b31d 100644 --- a/mats/patch-compile-0-f-t-f +++ b/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-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". diff --git a/mats/patch-compile-0-t-f-f b/mats/patch-compile-0-t-f-f index ec7fb76662..62950a52f0 100644 --- a/mats/patch-compile-0-t-f-f +++ b/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-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 #". @@ -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 #". 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". diff --git a/mats/patch-interpret-0-f-f-f b/mats/patch-interpret-0-f-f-f index e39f21886b..12f0b14084 100644 --- a/mats/patch-interpret-0-f-f-f +++ b/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-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". diff --git a/mats/patch-interpret-0-f-t-f b/mats/patch-interpret-0-f-t-f index c67721a398..aaf18e3f98 100644 --- a/mats/patch-interpret-0-f-t-f +++ b/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-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". diff --git a/mats/patch-interpret-3-f-f-f b/mats/patch-interpret-3-f-f-f index 3f21958260..497d1b0d32 100644 --- a/mats/patch-interpret-3-f-f-f +++ b/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-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 ---- diff --git a/mats/patch-interpret-3-f-t-f b/mats/patch-interpret-3-f-t-f index 8759849637..9674dab25f 100644 --- a/mats/patch-interpret-3-f-t-f +++ b/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-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 ---- diff --git a/mats/root-experr-compile-0-f-f-f b/mats/root-experr-compile-0-f-f-f index e19ee4e864..2e70a8bd09 100644 --- a/mats/root-experr-compile-0-f-f-f +++ b/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". diff --git a/mats/root-experr-compile-2-f-f-f b/mats/root-experr-compile-2-f-f-f index e19ee4e864..2e70a8bd09 100644 --- a/mats/root-experr-compile-2-f-f-f +++ b/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". diff --git a/release_notes/release_notes.stex b/release_notes/release_notes.stex index f6db5ae95d..8fd540cb61 100644 --- a/release_notes/release_notes.stex +++ b/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 diff --git a/s/5_3.ss b/s/5_3.ss index 9722572d83..97b71d9616 100644 --- a/s/5_3.ss +++ b/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))]) diff --git a/s/primdata.ss b/s/primdata.ss index b4f48f33cd..4c6dc53129 100644 --- a/s/primdata.ss +++ b/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]) diff --git a/s/record.ss b/s/record.ss index 3849c55d4b..b38a787a22 100644 --- a/s/record.ss +++ b/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) diff --git a/s/syntax.ss b/s/syntax.ss index ae0b68ea08..38bc19d9df 100644 --- a/s/syntax.ss +++ b/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) diff --git a/wininstall/locate-vcredist.bat b/wininstall/locate-vcredist.bat index c31aeba68b..f9b39cbf3e 100755 --- a/wininstall/locate-vcredist.bat +++ b/wininstall/locate-vcredist.bat @@ -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