diff --git a/typed-racket-lib/typed-racket/optimizer/box.rkt b/typed-racket-lib/typed-racket/optimizer/box.rkt index a3db8561..885358b4 100644 --- a/typed-racket-lib/typed-racket/optimizer/box.rkt +++ b/typed-racket-lib/typed-racket/optimizer/box.rkt @@ -7,10 +7,10 @@ (provide box-opt-expr) +;; set-box! is not optimized since the box might be immutable (define-unsafe-syntax-class unbox) -(define-unsafe-syntax-class set-box!) -(define-merged-syntax-class box-op (unbox^ set-box!^)) +(define-merged-syntax-class box-op (unbox^)) (define-syntax-class box-opt-expr #:commit diff --git a/typed-racket-lib/typed-racket/optimizer/vector.rkt b/typed-racket-lib/typed-racket/optimizer/vector.rkt index 424a1548..40ca65cb 100644 --- a/typed-racket-lib/typed-racket/optimizer/vector.rkt +++ b/typed-racket-lib/typed-racket/optimizer/vector.rkt @@ -24,10 +24,17 @@ (define-unsafe-syntax-class extflvector-set!) (define-syntax-class vector-op + #:attributes (unsafe unsafe-no-impersonator check-immutable?) #:commit ;; we need the non-* versions of these unsafe operations to be chaperone-safe - (pattern :vector-ref^ #:with unsafe #'unsafe-vector-ref #:with unsafe-no-impersonator #'unsafe-vector*-ref) - (pattern :vector-set!^ #:with unsafe #'unsafe-vector-set! #:with unsafe-no-impersonator #'unsafe-vector*-set!)) + ;; the `immutable?` attribute tells if we should fall back to the unoptimized version + ;; when the value is immutable + (pattern :vector-ref^ + #:with unsafe #'unsafe-vector-ref + #:with unsafe-no-impersonator #'unsafe-vector*-ref + #:attr check-immutable? #false) + (pattern :vector-set!^ #:with unsafe #'unsafe-vector-set! #:with unsafe-no-impersonator #'unsafe-vector*-set! + #:attr check-immutable? #true)) (define-merged-syntax-class flvector-op (flvector-ref^ flvector-set!^ extflvector-ref^ extflvector-set!^)) (define-syntax-class known-length-vector-expr @@ -67,7 +74,12 @@ (pattern (#%plain-app op:vector-op v:known-length-vector-expr i:value-expr new:opt-expr ...) #:when (<= 0 (attribute i.val) (sub1 (attribute v.len))) #:do [(log-opt "vector" "Vector bounds checking elimination.")] - #:with opt #'(op.unsafe v.opt i.opt new.opt ...)) + #:with opt #`(let ([new-v v.opt]) + #,(if (attribute op.check-immutable?) + #`(when (immutable? new-v) + (op new-v i.opt new.opt ...)) ; produces the correct error message + #'(begin)) + #'(op.unsafe v.opt i.opt new.opt ...))) ;; we can do the bounds checking separately, to eliminate some of the checks (pattern (#%plain-app op:vector-op v:opt-expr i:fixnum-expr new:opt-expr ...) @@ -78,6 +90,10 @@ [i-known-nonneg? (subtypeof? #'i -NonNegFixnum)]) #`(let ([new-i i.opt] [new-v v.opt]) + #,(if (attribute op.check-immutable?) + #`(when (immutable? new-v) + #,safe-fallback) ; produces the correct error message + #'(begin)) ;; do the impersonator check up front, to avoid doing it twice (length and op) (if (impersonator? new-v) (if #,(let ([one-sided #'(unsafe-fx< new-i (unsafe-vector-length new-v))]) diff --git a/typed-racket-test/fail/vector-set-immutable.rkt b/typed-racket-test/fail/vector-set-immutable.rkt new file mode 100644 index 00000000..b620cd73 --- /dev/null +++ b/typed-racket-test/fail/vector-set-immutable.rkt @@ -0,0 +1,6 @@ +#; +(exn-pred exn:fail?) +#lang typed/racket + +(define v : (Vectorof Integer) (vector-immutable 1 2 3)) +(vector-set! v 0 0)