From 06cbc94ced8a21f2cdc123dce259e4a65a8d3efe Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 22 Feb 2020 13:23:05 -0700 Subject: [PATCH] sync with updated Chez Scheme --- pkgs/base/info.rkt | 2 +- racket/src/cs/bootstrap/primdata.rkt | 22 +++++++++++++++++++- racket/src/cs/bootstrap/scheme-lang.rkt | 2 ++ racket/src/cs/bootstrap/scheme-readtable.rkt | 20 +++++++++++++++++- racket/src/cs/bootstrap/scheme-struct.rkt | 5 ++++- racket/src/cs/compile-file.ss | 2 +- racket/src/racket/src/schvers.h | 2 +- 7 files changed, 49 insertions(+), 6 deletions(-) diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index a8cefb948b..9f9c7025db 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "7.6.0.13") +(define version "7.6.0.14") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/racket/src/cs/bootstrap/primdata.rkt b/racket/src/cs/bootstrap/primdata.rkt index 5e10b11c65..1b3f773a29 100644 --- a/racket/src/cs/bootstrap/primdata.rkt +++ b/racket/src/cs/bootstrap/primdata.rkt @@ -36,6 +36,19 @@ (hash-ref bits flag))))] [_ (loop)]))))] [else #hasheq()])) + (define primref-variant + (call-with-input-file* + (build-path scheme-dir "s/primref.ss") + (lambda (i) + (define decl (parameterize ([current-readtable scheme-readtable]) + (read i))) + (match decl + [`(define-record-type primref + (nongenerative ,variant) + . ,_) + variant] + [_ + (error "cannot parse content of s/primref.ss")])))) (define priminfos (make-hasheq)) (when scheme-dir (call-with-input-file* @@ -64,7 +77,14 @@ (cadr id))) id)) (define flag-bits (flags->bits flags)) - (define pr (primref plain-id flag-bits (map sig->interface sigs) sigs)) + (define interface (map sig->interface sigs)) + (define pr (case primref-variant + [(|{primref a0xltlrcpeygsahopkplcn-3}|) + (primref3 plain-id flag-bits interface sigs)] + [(|{primref a0xltlrcpeygsahopkplcn-2}|) + (primref2 plain-id flag-bits interface)] + [else (error "unrecognized primref variant in s/primref.ss" + primref-variant)])) (register-symbols plain-id) ($sputprop plain-id '*prim2* pr) ($sputprop plain-id '*prim3* pr) diff --git a/racket/src/cs/bootstrap/scheme-lang.rkt b/racket/src/cs/bootstrap/scheme-lang.rkt index c95f4851d5..33d448862a 100644 --- a/racket/src/cs/bootstrap/scheme-lang.rkt +++ b/racket/src/cs/bootstrap/scheme-lang.rkt @@ -98,6 +98,7 @@ $set-top-level-value! $profile-source-data? $compile-profile + compile-profile $optimize-closures $profile-block-data? run-cp0 @@ -893,6 +894,7 @@ #f) (define $compile-profile (make-parameter #f)) +(define compile-profile $compile-profile) (define $optimize-closures (make-parameter #t)) (define $profile-block-data? (make-parameter #f)) (define run-cp0 (make-parameter error)) diff --git a/racket/src/cs/bootstrap/scheme-readtable.rkt b/racket/src/cs/bootstrap/scheme-readtable.rkt index f69d745d48..476cbb9144 100644 --- a/racket/src/cs/bootstrap/scheme-readtable.rkt +++ b/racket/src/cs/bootstrap/scheme-readtable.rkt @@ -24,6 +24,24 @@ [else (hash-graph #\2 in src line col pos)])) +(define (hash-one c in src line col pos) + (define got-c (peek-char in)) + (cond + [(eqv? #\# got-c) + ;; "read.ss" has a `#1#` reference before the + ;; `#1=...` definition; it's going to turn out + ;; to be `black-hole` + (define name (object-name in)) + (cond + [(and (or (string? name) (path? name)) + (regexp-match? #rx"read[.]ss$" name)) + (read-char in) + black-hole] + [else + (hash-graph #\1 in src line col pos)])] + [else + (hash-graph #\1 in src line col pos)])) + (define (hash-graph c in src line col pos) (cond [(and (eqv? (peek-char in) #\=) @@ -130,7 +148,7 @@ (make-readtable #f #\0 'dispatch-macro hash-graph - #\1 'dispatch-macro hash-graph + #\1 'dispatch-macro hash-one #\2 'dispatch-macro hash-two #\3 'dispatch-macro hash-three #\4 'dispatch-macro hash-graph diff --git a/racket/src/cs/bootstrap/scheme-struct.rkt b/racket/src/cs/bootstrap/scheme-struct.rkt index 72db203093..094d2ba3b9 100644 --- a/racket/src/cs/bootstrap/scheme-struct.rkt +++ b/racket/src/cs/bootstrap/scheme-struct.rkt @@ -19,5 +19,8 @@ (struct rec-cons-desc (rtd parent-rcd protocol) #:prefab #:mutable #:reflection-name '|{rcd qh0yzh5qyrxmz2l-a}|) -(struct primref (name flags arity signatures) #:prefab #:mutable +(struct primref2 (name flags arity) #:prefab #:mutable + #:reflection-name '|{primref a0xltlrcpeygsahopkplcn-2}|) + +(struct primref3 (name flags arity signatures) #:prefab #:mutable #:reflection-name '|{primref a0xltlrcpeygsahopkplcn-3}|) diff --git a/racket/src/cs/compile-file.ss b/racket/src/cs/compile-file.ss index 658eb195af..9c5eb218f7 100644 --- a/racket/src/cs/compile-file.ss +++ b/racket/src/cs/compile-file.ss @@ -2,7 +2,7 @@ ;; Check to make we're using a build of Chez Scheme ;; that has all the features we need. (define-values (need-maj need-min need-sub need-dev) - (values 9 5 3 20)) + (values 9 5 3 21)) (unless (guard (x [else #f]) (eval 'scheme-fork-version-number)) (error 'compile-file diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index c3862a8d45..66f7abd896 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -16,7 +16,7 @@ #define MZSCHEME_VERSION_X 7 #define MZSCHEME_VERSION_Y 6 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 13 +#define MZSCHEME_VERSION_W 14 /* A level of indirection makes `#` work as needed: */ #define AS_a_STR_HELPER(x) #x