diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index d0c046650d..c02dc2c069 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -12,7 +12,7 @@ (define collection 'multi) -(define version "6.90.0.19") +(define version "6.90.0.20") (define deps `("racket-lib" ["racket" #:version ,version])) diff --git a/pkgs/racket-doc/scribblings/reference/stx-props.scrbl b/pkgs/racket-doc/scribblings/reference/stx-props.scrbl index 0c8731f61b..87210bbfb1 100644 --- a/pkgs/racket-doc/scribblings/reference/stx-props.scrbl +++ b/pkgs/racket-doc/scribblings/reference/stx-props.scrbl @@ -157,6 +157,16 @@ attempt to marshal the owning syntax object to bytecode form. @history[#:changed "6.4.0.14" @elem{Added the @racket[preserved?] argument.}]} +@defproc[(syntax-property-remove [stx syntax?] + [key any/c]) + syntax?]{ + +Returns a syntax object like @racket[stx], but without a property (if +any) for @racket[key]. + +@history[#:added "6.90.0.20"]} + + @defproc[(syntax-property-preserved? [stx syntax?] [key (and/c symbol? symbol-interned?)]) boolean?]{ diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl index c5cff0f984..917b5005ff 100644 --- a/pkgs/racket-test-core/tests/racket/stx.rktl +++ b/pkgs/racket-test-core/tests/racket/stx.rktl @@ -49,6 +49,10 @@ (datum->syntax #f '(a) #f (syntax-property #'x 'ok 'value)) 'ok) +(let ([s (syntax-property #'s 'key 'val)]) + (test 'val syntax-property s 'key) + (test #f syntax-property (syntax-property-remove s 'key) 'key)) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; some syntax-case patterns ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/racket/src/expander/boot/core-primitive.rkt b/racket/src/expander/boot/core-primitive.rkt index bb3c07a881..469e61adb8 100644 --- a/racket/src/expander/boot/core-primitive.rkt +++ b/racket/src/expander/boot/core-primitive.rkt @@ -69,6 +69,7 @@ syntax-span syntax->list syntax-property + syntax-property-remove syntax-property-preserved? syntax-property-symbol-keys syntax-original? diff --git a/racket/src/expander/syntax/api.rkt b/racket/src/expander/syntax/api.rkt index 61a67cf1ef..1ac1d6bb1e 100644 --- a/racket/src/expander/syntax/api.rkt +++ b/racket/src/expander/syntax/api.rkt @@ -31,6 +31,7 @@ (provide syntax? syntax-e syntax-property + syntax-property-remove syntax-property-preserved? syntax-property-symbol-keys syntax-original? diff --git a/racket/src/expander/syntax/property.rkt b/racket/src/expander/syntax/property.rkt index 301d35e729..c46a8437be 100644 --- a/racket/src/expander/syntax/property.rkt +++ b/racket/src/expander/syntax/property.rkt @@ -50,7 +50,8 @@ #:when (and (symbol? k) (symbol-interned? k))) k)) -(define (syntax-property-remove s key) +(define/who (syntax-property-remove s key) + (check who syntax? s) (if (hash-ref (syntax-props s) key #f) (struct-copy syntax s [props (hash-remove (syntax-props s) key)]) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index 1293c6ebfb..5d78419c03 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "6.90.0.19" +#define MZSCHEME_VERSION "6.90.0.20" #define MZSCHEME_VERSION_X 6 #define MZSCHEME_VERSION_Y 90 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 19 +#define MZSCHEME_VERSION_W 20 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/racket/src/racket/src/startup.inc b/racket/src/racket/src/startup.inc index b2ffc6d619..96f8f8e814 100644 --- a/racket/src/racket/src/startup.inc +++ b/racket/src/racket/src/startup.inc @@ -7592,10 +7592,14 @@ static const char *startup_source = "(syntax-property-remove)" "(lambda(s_72 key_28)" "(begin" +"(let-values()" +"(let-values()" +"(begin" +" (if (syntax?$1 s_72) (void) (let-values () (raise-argument-error 'syntax-property-remove \"syntax?\" s_72)))" "(if(hash-ref(syntax-props s_72) key_28 #f)" "(let-values(((the-struct_5) s_72))" "(if(syntax?$1 the-struct_5)" -"(let-values(((props6_0)(hash-remove(syntax-props s_72) key_28)))" +"(let-values(((props7_0)(hash-remove(syntax-props s_72) key_28)))" "(syntax1.1" "(syntax-content the-struct_5)" "(syntax-scopes the-struct_5)" @@ -7603,10 +7607,10 @@ static const char *startup_source = "(syntax-scope-propagations+tamper the-struct_5)" "(syntax-mpi-shifts the-struct_5)" "(syntax-srcloc the-struct_5)" -" props6_0" +" props7_0" "(syntax-inspector the-struct_5)))" -" (raise-argument-error 'struct-copy \"syntax?\" the-struct_5)))" -" s_72))))" +" (raise-argument-error 'struct-copy \"syntax?\" the-struct_5)))" +" s_72)))))))" "(define-values" "(taint-content)" "(lambda(d_2)" @@ -12422,7 +12426,7 @@ static const char *startup_source = "(cons id_10 old-origin_0))))" "(let-values(((the-struct_35) new-stx_0))" "(if(syntax?$1 the-struct_35)" -"(let-values(((props7_0)(hash-set old-props_0 'origin origin_0)))" +"(let-values(((props7_1)(hash-set old-props_0 'origin origin_0)))" "(syntax1.1" "(syntax-content the-struct_35)" "(syntax-scopes the-struct_35)" @@ -12430,7 +12434,7 @@ static const char *startup_source = "(syntax-scope-propagations+tamper the-struct_35)" "(syntax-mpi-shifts the-struct_35)" "(syntax-srcloc the-struct_35)" -" props7_0" +" props7_1" "(syntax-inspector the-struct_35)))" " (raise-argument-error 'struct-copy \"syntax?\" the-struct_35))))))" "(let-values()" @@ -58373,6 +58377,7 @@ static const char *startup_source = " 'syntax-span" " 'syntax->list" " 'syntax-property" +" 'syntax-property-remove" " 'syntax-property-preserved?" " 'syntax-property-symbol-keys" " 'syntax-original?" @@ -58508,6 +58513,7 @@ static const char *startup_source = "(add-core-primitive! 'syntax-span 1/syntax-span)" "(add-core-primitive! 'syntax->list 1/syntax->list)" "(add-core-primitive! 'syntax-property syntax-property$1)" +"(add-core-primitive! 'syntax-property-remove syntax-property-remove)" "(add-core-primitive! 'syntax-property-preserved? 1/syntax-property-preserved?)" "(add-core-primitive! 'syntax-property-symbol-keys 1/syntax-property-symbol-keys)" "(add-core-primitive! 'syntax-original? 1/syntax-original?)"