diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 64a1d12b15..647a4409c3 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -14,7 +14,7 @@ ;; In the Racket source repo, this version should change only when ;; "racket_version.h" changes: -(define version "8.0.0.4") +(define version "8.0.0.5") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/bc/src/startup.inc b/racket/src/bc/src/startup.inc index fec82e702d..92afa8cb7b 100644 --- a/racket/src/bc/src/startup.inc +++ b/racket/src/bc/src/startup.inc @@ -20081,7 +20081,11 @@ static const char *startup_source = "(if(unsafe-fx< index_0 25)" "(let-values()" "(let-values(((wrt-dir_0)" +"(let-values(((or-part_0)" "(current-load-relative-directory)))" +"(if or-part_0" +" or-part_0" +"(current-directory)))))" "(let-values(((rel-elems_0)" "(reverse$1" "(let-values(((lst_0)" diff --git a/racket/src/cs/io.sls b/racket/src/cs/io.sls index 93d27afa29..ab0b5b5192 100644 --- a/racket/src/cs/io.sls +++ b/racket/src/cs/io.sls @@ -586,7 +586,7 @@ 1/srcloc->string 1/error-print-source-location) (set-ffi-get-lib-and-obj! ffi-get-lib ffi-get-obj ffi-unload-lib ptr->address) - (set-make-async-callback-poll-wakeup! unsafe-make-signal-received) + (set-make-async-callback-poll-wakeup! 1/unsafe-make-signal-received) (set-get-machine-info! get-machine-info) (set-processor-count! (1/processor-count)) (install-future-logging-procs! logging-future-events? log-future-event) diff --git a/racket/src/cs/schemified/io.scm b/racket/src/cs/schemified/io.scm index 4b2c15b92b..9d6cbfb276 100644 --- a/racket/src/cs/schemified/io.scm +++ b/racket/src/cs/schemified/io.scm @@ -328,7 +328,7 @@ unsafe-file-descriptor->semaphore) (1/unsafe-make-security-guard-at-root unsafe-make-security-guard-at-root) - (unsafe-make-signal-received unsafe-make-signal-received) + (1/unsafe-make-signal-received unsafe-make-signal-received) (1/unsafe-poll-ctx-eventmask-wakeup unsafe-poll-ctx-eventmask-wakeup) (1/unsafe-poll-ctx-fd-wakeup unsafe-poll-ctx-fd-wakeup) @@ -38734,10 +38734,13 @@ unsafe-signal-received (lambda () (begin (|#%app| rktio_signal_received (unsafe-place-local-ref cell.1)))))) -(define unsafe-make-signal-received - (lambda () - (let ((rktio_0 (unsafe-place-local-ref cell.1))) - (lambda () (|#%app| rktio_signal_received rktio_0))))) +(define 1/unsafe-make-signal-received + (|#%name| + unsafe-make-signal-received + (lambda () + (begin + (let ((rktio_0 (unsafe-place-local-ref cell.1))) + (lambda () (|#%app| rktio_signal_received rktio_0))))))) (define 1/unsafe-set-sleep-in-thread! (|#%name| unsafe-set-sleep-in-thread! diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm index 80d3ea061a..2a264982ea 100644 --- a/racket/src/cs/schemified/schemify.scm +++ b/racket/src/cs/schemified/schemify.scm @@ -21199,6 +21199,46 @@ (let ((or-part_0 (number? val_1))) (if or-part_0 or-part_0 (char? val_1))))) (let ((val_0 (unwrap e_0))) (number? val_0)))))) +(define always-eq/no-marks? + (lambda (e1_0 e2_0 mutated_0) + (let ((hd_0 + (let ((p_0 (unwrap e1_0))) (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'quote hd_0) + (let ((a_0 (cdr (unwrap e1_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((v1_0 + (let ((d_0 (cdr (unwrap e1_0)))) + (let ((a_0 (car (unwrap d_0)))) a_0)))) + (let ((hd_1 + (let ((p_0 (unwrap e2_0))) + (if (pair? p_0) (unwrap (car p_0)) #f)))) + (if (if (eq? 'quote hd_1) + (let ((a_0 (cdr (unwrap e2_0)))) + (let ((p_0 (unwrap a_0))) + (if (pair? p_0) + (let ((a_1 (cdr p_0))) + (begin-unsafe + (let ((app_0 (unwrap '()))) + (eq? app_0 (unwrap a_1))))) + #f))) + #f) + (let ((v2_0 + (let ((d_0 (cdr (unwrap e2_0)))) + (let ((a_0 (car (unwrap d_0)))) a_0)))) + (eq? v1_0 v2_0)) + #f))) + (let ((u-e1_0 (unwrap e1_0))) + (if (symbol? u-e1_0) + (if (eq? u-e1_0 (unwrap e2_0)) + (simple-mutated-state? (hash-ref mutated_0 u-e1_0 #f)) + #f) + #f)))))) (define unnest-let (lambda (e_0 prim-knowns_0 @@ -28305,57 +28345,286 @@ prim-knowns_0 imports_0 mutated_0))) - (if (if authentic-key?_0 - (simple?.1 - #f - #t - #f - s-body_0 - prim-knowns_0 - knowns_1 - imports_0 - mutated_0 - simples_0 - unsafe-mode?_0) - #f) - (let ((app_0 - (ensure-single-valued - s-key_0 - knowns_1 - prim-knowns_0 - imports_0 - mutated_0))) - (list - 'begin - app_0 - (ensure-single-valued - s-val_0 - knowns_1 - prim-knowns_0 - imports_0 - mutated_0) - s-body_0)) - (if (eq? - target_0 - 'cify) - (list - 'with-continuation-mark - s-key_0 - s-val_0 - s-body_0) - (let ((mode_0 - (if (eq? - wcm-state_2 - 'fresh) - (if authentic-key?_0 - 'push-authentic - 'push) - (if authentic-key?_0 - 'authentic - 'general)))) - (list - 'with-continuation-mark* - mode_0 + (let ((build-wcm_0 + (|#%name| + build-wcm + (lambda (s-key_1 + s-val_1 + s-body_1) + (begin + (if (eq? + target_0 + 'cify) + (list + 'with-continuation-mark + s-key_1 + s-val_1 + s-body_1) + (let ((mode_0 + (if (eq? + wcm-state_2 + 'fresh) + (if authentic-key?_0 + 'push-authentic + 'push) + (if authentic-key?_0 + 'authentic + 'general)))) + (list + 'with-continuation-mark* + mode_0 + s-key_1 + s-val_1 + s-body_1)))))))) + (let ((build-begin_0 + (|#%name| + build-begin + (lambda (s-key_1 + s-val_1 + s-body_1) + (begin + (if (if (simple?.1 + #f + #t + 1 + s-key_1 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0) + (simple?.1 + #f + #t + 1 + s-val_1 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0) + #f) + s-body_1 + (let ((app_0 + (ensure-single-valued + s-key_1 + knowns_1 + prim-knowns_0 + imports_0 + mutated_0))) + (list + 'begin + app_0 + (ensure-single-valued + s-val_1 + knowns_1 + prim-knowns_0 + imports_0 + mutated_0) + s-body_1)))))))) + (if authentic-key?_0 + (if (simple?.1 + #f + #t + #f + s-body_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0) + (build-begin_0 + s-key_0 + s-val_0 + s-body_0) + (let ((hd_1 + (let ((p_0 + (unwrap + s-body_0))) + (if (pair? + p_0) + (unwrap + (car + p_0)) + #f)))) + (if (if (eq? + 'with-continuation-mark* + hd_1) + (let ((a_0 + (cdr + (unwrap + s-body_0)))) + (let ((p_0 + (unwrap + a_0))) + (if (pair? + p_0) + (let ((a_1 + (cdr + p_0))) + (let ((p_1 + (unwrap + a_1))) + (if (pair? + p_1) + (let ((a_2 + (cdr + p_1))) + (let ((p_2 + (unwrap + a_2))) + (if (pair? + p_2) + (let ((a_3 + (cdr + p_2))) + (let ((p_3 + (unwrap + a_3))) + (if (pair? + p_3) + (let ((a_4 + (cdr + p_3))) + (begin-unsafe + (let ((app_0 + (unwrap + '()))) + (eq? + app_0 + (unwrap + a_4))))) + #f))) + #f))) + #f))) + #f))) + #f) + (call-with-values + (lambda () + (let ((d_0 + (cdr + (unwrap + s-body_0)))) + (let ((p_0 + (unwrap + d_0))) + (let ((mode2_0 + (let ((a_0 + (car + p_0))) + a_0))) + (call-with-values + (lambda () + (let ((d_1 + (cdr + p_0))) + (let ((p_1 + (unwrap + d_1))) + (let ((s-key2_0 + (let ((a_0 + (car + p_1))) + a_0))) + (call-with-values + (lambda () + (let ((d_2 + (cdr + p_1))) + (let ((p_2 + (unwrap + d_2))) + (let ((s-val2_0 + (let ((a_0 + (car + p_2))) + a_0))) + (let ((s-body2_0 + (let ((d_3 + (cdr + p_2))) + (let ((a_0 + (car + (unwrap + d_3)))) + a_0)))) + (let ((s-val2_1 + s-val2_0)) + (values + s-val2_1 + s-body2_0))))))) + (case-lambda + ((s-val2_0 + s-body2_0) + (let ((s-key2_1 + s-key2_0)) + (values + s-key2_1 + s-val2_0 + s-body2_0))) + (args + (raise-binding-result-arity-error + 2 + args)))))))) + (case-lambda + ((s-key2_0 + s-val2_0 + s-body2_0) + (let ((mode2_1 + mode2_0)) + (values + mode2_1 + s-key2_0 + s-val2_0 + s-body2_0))) + (args + (raise-binding-result-arity-error + 3 + args)))))))) + (case-lambda + ((mode2_0 + s-key2_0 + s-val2_0 + s-body2_0) + (if (if (always-eq/no-marks? + s-key_0 + s-key2_0 + mutated_0) + (simple?.1 + #f + #t + 1 + s-val2_0 + prim-knowns_0 + knowns_1 + imports_0 + mutated_0 + simples_0 + unsafe-mode?_0) + #f) + (build-begin_0 + s-key_0 + s-val_0 + (build-wcm_0 + s-key2_0 + s-val2_0 + s-body2_0)) + (build-wcm_0 + s-key_0 + s-val_0 + s-body_0))) + (args + (raise-binding-result-arity-error + 4 + args)))) + (build-wcm_0 + s-key_0 + s-val_0 + s-body_0)))) + (build-wcm_0 s-key_0 s-val_0 s-body_0))))))))) diff --git a/racket/src/schemify/equal.rkt b/racket/src/schemify/equal.rkt index e56292fd37..cb39aef6d3 100644 --- a/racket/src/schemify/equal.rkt +++ b/racket/src/schemify/equal.rkt @@ -1,13 +1,15 @@ #lang racket/base (require "wrap.rkt" - "match.rkt") + "match.rkt" + "mutated-state.rkt") ;; Since a Racket `equal?` will shadow the host Scheme's `equal?`, ;; its optimizer won't be able to reduce `equal?` to `eq?` or `eqv?` ;; with obvious arguments. So, we perform that conversion in schemify. (provide equal-implies-eq? - equal-implies-eqv?) + equal-implies-eqv? + always-eq/no-marks?) (define (equal-implies-eq? e) (match e @@ -38,3 +40,19 @@ [`,val (let ([val (unwrap val)]) (number? val))])) + +;; e1 and e2 have been simplified; +;; return #t only if e2 doesn't try to +;; consult continuation marks +(define (always-eq/no-marks? e1 e2 mutated) + (match e1 + [`(quote ,v1) + (match e2 + [`(quote ,v2) + (eq? v1 v2)] + [`,_ #f])] + [`,_ + (define u-e1 (unwrap e1)) + (and (symbol? u-e1) + (eq? u-e1 (unwrap e2)) + (simple-mutated-state? (hash-ref mutated u-e1 #f)))])) diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index 1d44b6e012..639cb8c182 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -659,20 +659,51 @@ (define s-body (schemify body 'marked)) (define authentic-key? (authentic-valued? key knowns prim-knowns imports mutated)) + (define (build-wcm s-key s-val s-body) + (cond + [(aim? target 'cify) + `(with-continuation-mark ,s-key ,s-val ,s-body)] + [else + (define mode + (case wcm-state + [(fresh) (if authentic-key? 'push-authentic 'push)] + [else (if authentic-key? 'authentic 'general)])) + `(with-continuation-mark* ,mode ,s-key ,s-val ,s-body)])) + (define (build-begin s-key s-val s-body) + (cond + [(and (simple? s-key prim-knowns knowns imports mutated simples unsafe-mode?) + (simple? s-val prim-knowns knowns imports mutated simples unsafe-mode?)) + ;; Avoid `begin` wrapper to help further `with-continuation-mark` optimizations + s-body] + [else + `(begin ,(ensure-single-valued s-key knowns prim-knowns imports mutated) + ,(ensure-single-valued s-val knowns prim-knowns imports mutated) + ,s-body)])) (cond - [(and authentic-key? - (simple? s-body prim-knowns knowns imports mutated simples unsafe-mode? #:result-arity #f)) - `(begin ,(ensure-single-valued s-key knowns prim-knowns imports mutated) - ,(ensure-single-valued s-val knowns prim-knowns imports mutated) - ,s-body)] - [(aim? target 'cify) - `(with-continuation-mark ,s-key ,s-val ,s-body)] + [authentic-key? + (cond + [(simple? s-body prim-knowns knowns imports mutated simples unsafe-mode? #:result-arity #f) + (build-begin s-key s-val s-body)] + [else + ;; Simplify (with-continuation-mark + ;; (with-continuation-mark + ;; ) + ;; to (begin + ;; (with-continuation-mark + ;; )) + ;; as long as and don't use marks + (match s-body + [`(with-continuation-mark* ,mode2 ,s-key2 ,s-val2 ,s-body2) + (cond + [(and (always-eq/no-marks? s-key s-key2 mutated) + (simple? s-val2 prim-knowns knowns imports mutated simples unsafe-mode?)) + (build-begin s-key s-val + ;; rebuild to use current `wcm-state`: + (build-wcm s-key2 s-val2 s-body2))] + [else (build-wcm s-key s-val s-body)])] + [`,_ (build-wcm s-key s-val s-body)])])] [else - (define mode - (case wcm-state - [(fresh) (if authentic-key? 'push-authentic 'push)] - [else (if authentic-key? 'authentic 'general)])) - `(with-continuation-mark* ,mode ,s-key ,s-val ,s-body)])] + (build-wcm s-key s-val s-body)])] [`(begin ,exp) (schemify exp wcm-state)] [`(begin ,exps ...) diff --git a/racket/src/schemify/simple.rkt b/racket/src/schemify/simple.rkt index e394ae054b..df0a1c6021 100644 --- a/racket/src/schemify/simple.rkt +++ b/racket/src/schemify/simple.rkt @@ -10,7 +10,7 @@ ;; Check whether an expression is simple in the sense that its order ;; of evaluation isn't detectable (`pure?` = #t) or at least it won't -;; try to capture a comtinuation (`pure?` = #f). In `pure?` mode, if +;; try to capture a continuation (`pure?` = #f). In `pure?` mode, if ;; `no-alloc?` is true, then allocation counts as detectable (for ;; ordering with respect to functions that might capture a continuation). ;; This function receives both schemified and non-schemified expressions. diff --git a/racket/src/version/racket_version.h b/racket/src/version/racket_version.h index 847a93ef8e..c1567748a8 100644 --- a/racket/src/version/racket_version.h +++ b/racket/src/version/racket_version.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 8 #define MZSCHEME_VERSION_Y 0 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 4 +#define MZSCHEME_VERSION_W 5 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x