add syntax-property-remove

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

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?]{
 

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

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?

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?

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

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)

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)))"
+"                  (raise-argument-error 'struct-copy \"syntax?\" the-struct_5)))"
-" s_72))))"
+" 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?)"