cs: faster struct impersonation
This commit is contained in:
Matthew Flatt
parent
615e4f707a
commit
1900c0e57a
|
|
@ -0,0 +1,26 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
;; Iterations for slow things:
|
||||
(define Q 1000000)
|
||||
|
||||
;; The depth used for non-tail recursion, typically:
|
||||
(define M (* Q 10))
|
||||
|
||||
;; Intermediate count:
|
||||
(define L (* M 10))
|
||||
|
||||
;; Number of iterations used for a loop, typically
|
||||
(define N (* L 10))
|
||||
|
||||
;; Number of times to run each benchmark:
|
||||
(define I 3)
|
||||
|
||||
(define-syntax times
|
||||
(syntax-rules ()
|
||||
[(_ e)
|
||||
(let loop ([v #f] [i I])
|
||||
(if (zero? i)
|
||||
v
|
||||
(loop (time e) (sub1 i))))]))
|
||||
|
|
@ -0,0 +1,161 @@
|
|||
#lang racket/base
|
||||
(require racket/unsafe/undefined
|
||||
"config.rkt")
|
||||
|
||||
(define-values (prop:mine mine? mine-ref)
|
||||
(make-struct-type-property 'mine))
|
||||
|
||||
(struct posn (x [y #:mutable])
|
||||
#:property prop:mine #t)
|
||||
|
||||
(struct posn3D posn ([z #:mutable]))
|
||||
|
||||
(struct posn/u (x [y #:mutable])
|
||||
#:property prop:mine #t
|
||||
#:property prop:chaperone-unsafe-undefined '(y x))
|
||||
|
||||
(struct posn3D/u posn/u ([z #:mutable])
|
||||
#:property prop:chaperone-unsafe-undefined '(z y x))
|
||||
|
||||
(define pt* (posn 1 2))
|
||||
(define pt3D* (posn3D 1 2 3))
|
||||
|
||||
(define pt*/u (posn/u 1 2))
|
||||
(define pt3D*/u (posn3D/u 1 2 3))
|
||||
|
||||
(define pt (chaperone-struct pt*
|
||||
posn-x (lambda (self v) v)
|
||||
set-posn-y! (lambda (self v) v)
|
||||
mine-ref (lambda (self v) v)))
|
||||
|
||||
(define pt3D (chaperone-struct pt3D*
|
||||
posn-x (lambda (self v) v)
|
||||
posn3D-z (lambda (self v) v)
|
||||
set-posn-y! (lambda (self v) v)
|
||||
set-posn3D-z! (lambda (self v) v)
|
||||
mine-ref (lambda (self v) v)))
|
||||
|
||||
(define pt/u (chaperone-struct pt*/u
|
||||
posn/u-x (lambda (self v) v)
|
||||
set-posn/u-y! (lambda (self v) v)
|
||||
mine-ref (lambda (self v) v)))
|
||||
|
||||
(define pt3D/u (chaperone-struct pt3D*/u
|
||||
posn/u-x (lambda (self v) v)
|
||||
posn3D/u-z (lambda (self v) v)
|
||||
set-posn/u-y! (lambda (self v) v)
|
||||
set-posn3D/u-z! (lambda (self v) v)
|
||||
mine-ref (lambda (self v) v)))
|
||||
|
||||
'----------------------------------------
|
||||
|
||||
'chaperone
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(chaperone-struct pt*
|
||||
posn-x (lambda (self v) v)))))
|
||||
|
||||
'chaperone-more
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(chaperone-struct pt
|
||||
posn-x (lambda (self v) v)))))
|
||||
|
||||
'chaperone-prop
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(chaperone-struct pt*
|
||||
mine-ref (lambda (self v) v)))))
|
||||
|
||||
'baseline-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(posn-x pt*))))
|
||||
|
||||
'baseline-set!
|
||||
(times
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(set-posn-y! pt* 8)))
|
||||
|
||||
'baseline-sub-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(posn3D-z pt3D*))))
|
||||
|
||||
'baseline-sub-set!
|
||||
(times
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(set-posn3D-z! pt3D* 9)))
|
||||
|
||||
'baseline-prop-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(mine-ref pt*))))
|
||||
|
||||
'undefined-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(posn/u-x pt*/u))))
|
||||
|
||||
'undefined-set!
|
||||
(times
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(set-posn/u-y! pt*/u 8)))
|
||||
|
||||
'undefined-prop-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(mine-ref pt*/u))))
|
||||
|
||||
'chaperoned-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(posn-x pt))))
|
||||
|
||||
'chaperoned-set!
|
||||
(times
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(set-posn-y! pt 8)))
|
||||
|
||||
'chaperoned-sub-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(posn3D-z pt3D))))
|
||||
|
||||
'chaperoned-sub-set!
|
||||
(times
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(set-posn3D-z! pt3D 9)))
|
||||
|
||||
'chaperoned-prop-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(mine-ref pt))))
|
||||
|
||||
'chaperoned-undefined-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(posn/u-x pt/u))))
|
||||
|
||||
'chaperoned-undefined-set!
|
||||
(times
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(set-posn/u-y! pt/u 8)))
|
||||
|
||||
'chaperoned-undefined-prop-ref
|
||||
(times
|
||||
(void
|
||||
(for/fold ([r #f]) ([i (in-range M)])
|
||||
(mine-ref pt/u))))
|
||||
|
|
@ -128,7 +128,7 @@
|
|||
(check (chaperone-of? fc f) #t)
|
||||
(check (chaperone-of? fi f) #f)
|
||||
(check (chaperone-of? fi fc) #f)
|
||||
(check (chaperone-of? fc fi) #t)
|
||||
(check (chaperone-of? fc fi) #f)
|
||||
|
||||
(define fc2 (chaperone-procedure f
|
||||
(lambda (x y)
|
||||
|
|
@ -348,7 +348,7 @@
|
|||
(check (ops!) '(set equal-key))
|
||||
|
||||
(check (hash-ref (hash-remove ht1c 1) 1 'none) 'none)
|
||||
(check (ops!) '(remove equal-key get equal-key equal-key))
|
||||
(check (ops!) '(remove equal-key get equal-key))
|
||||
(check (begin
|
||||
(hash-remove! ht2c 1)
|
||||
(hash-ref ht2c 1 'none))
|
||||
|
|
|
|||
|
|
@ -22,22 +22,41 @@
|
|||
"original" e
|
||||
"received" e2))
|
||||
|
||||
(define (hash-ref2 ht key1 key2 default)
|
||||
(let ([ht/val (intmap-ref ht key1 #f)])
|
||||
(if (and key2 ht/val)
|
||||
(intmap-ref ht/val key2 #f)
|
||||
ht/val)))
|
||||
|
||||
(define (hash-set2 ht key1 key2 val)
|
||||
(intmap-set ht key1 (if key2
|
||||
(intmap-set (intmap-ref ht key1 empty-hasheq) key2 val)
|
||||
val)))
|
||||
|
||||
(define (impersonate-ref acc rtd pos orig record-name field-name)
|
||||
(#%$app/no-inline do-impersonate-ref acc rtd pos orig record-name field-name))
|
||||
|
||||
(define (do-impersonate-ref acc rtd pos orig record-name field-name)
|
||||
(impersonate-struct-or-property-ref acc rtd (cons rtd pos) orig record-name field-name))
|
||||
(impersonate-struct-or-property-ref acc rtd rtd pos orig record-name field-name))
|
||||
|
||||
(define (impersonate-struct-or-property-ref acc rtd key orig record-name field-name)
|
||||
(define (impersonate-struct-or-property-ref acc rtd key1 key2/pos orig record-name field-name)
|
||||
(cond
|
||||
[(and (impersonator? orig)
|
||||
(or (not rtd)
|
||||
(record? (impersonator-val orig) rtd)))
|
||||
(let loop ([v orig])
|
||||
(cond
|
||||
[(and (struct-undefined-chaperone? v)
|
||||
rtd)
|
||||
;; Must be the only wrapper left
|
||||
(let ([abs-pos (fx+ key2/pos (struct-type-parent-total*-count rtd))])
|
||||
(let ([r (unsafe-struct*-ref (impersonator-val v) abs-pos)])
|
||||
(when (eq? r unsafe-undefined)
|
||||
(raise-unsafe-undefined 'struct-ref "undefined" "use" acc (impersonator-val v) abs-pos))
|
||||
r))]
|
||||
[(or (struct-impersonator? v)
|
||||
(struct-chaperone? v))
|
||||
(let ([wrapper (hash-ref (struct-impersonator/chaperone-procs v) key #f)])
|
||||
(let ([wrapper (hash-ref2 (struct-impersonator/chaperone-procs v) key1 key2/pos #f)])
|
||||
(cond
|
||||
[wrapper
|
||||
(let* ([r (cond
|
||||
|
|
@ -55,16 +74,13 @@
|
|||
new-r)]
|
||||
[else
|
||||
(loop (impersonator-next v))]))]
|
||||
[(and (struct-undefined-chaperone? v)
|
||||
rtd)
|
||||
(let ([r (loop (impersonator-next v))])
|
||||
(when (eq? r unsafe-undefined)
|
||||
(let ([abs-pos (fx+ (cdr key) (struct-type-parent-total*-count (car key)))])
|
||||
(raise-unsafe-undefined 'struct-ref "undefined" "use" acc (impersonator-val v) abs-pos)))
|
||||
r)]
|
||||
[(impersonator? v)
|
||||
(loop (impersonator-next v))]
|
||||
[else (|#%app| acc v)]))]
|
||||
[else
|
||||
(if rtd
|
||||
(let ([abs-pos (fx+ key2/pos (struct-type-parent-total*-count rtd))])
|
||||
(unsafe-struct*-ref v abs-pos))
|
||||
(|#%app| acc v))]))]
|
||||
[else
|
||||
(raise-argument-error (string->symbol
|
||||
(string-append (symbol->string (or record-name 'struct))
|
||||
|
|
@ -76,16 +92,27 @@
|
|||
(define (impersonate-set! set rtd pos abs-pos orig a record-name field-name)
|
||||
(#%$app/no-inline do-impersonate-set! set rtd pos abs-pos orig a record-name field-name))
|
||||
|
||||
(define (struct-mutator-pos->key2 pos) (fx- -1 pos))
|
||||
|
||||
(define (do-impersonate-set! set rtd pos abs-pos orig a record-name field-name)
|
||||
(cond
|
||||
[(and (impersonator? orig)
|
||||
(record? (impersonator-val orig) rtd))
|
||||
(let ([key (vector rtd pos)])
|
||||
(let ([key1 rtd]
|
||||
[key2 (struct-mutator-pos->key2 pos)])
|
||||
(let loop ([v orig] [a a])
|
||||
(cond
|
||||
[(struct-undefined-chaperone? v)
|
||||
;; Must be the only wrapper left
|
||||
(let ([v (impersonator-val v)])
|
||||
(when (eq? (unsafe-struct*-ref v abs-pos) unsafe-undefined)
|
||||
(unless (eq? (continuation-mark-set-first #f prop:chaperone-unsafe-undefined)
|
||||
unsafe-undefined)
|
||||
(raise-unsafe-undefined 'struct-set! "assignment disallowed" "assign" set v abs-pos)))
|
||||
(unsafe-struct*-set! v abs-pos a))]
|
||||
[(or (struct-impersonator? v)
|
||||
(struct-chaperone? v))
|
||||
(let ([wrapper (hash-ref (struct-impersonator/chaperone-procs v) key #f)])
|
||||
(let ([wrapper (hash-ref2 (struct-impersonator/chaperone-procs v) key1 key2 #f)])
|
||||
(cond
|
||||
[wrapper
|
||||
(let ([new-a (cond
|
||||
|
|
@ -102,15 +129,11 @@
|
|||
(loop (impersonator-next v) new-a)]))]
|
||||
[else
|
||||
(loop (impersonator-next v) a)]))]
|
||||
[(struct-undefined-chaperone? v)
|
||||
(when (eq? (unsafe-struct*-ref (impersonator-val v) abs-pos) unsafe-undefined)
|
||||
(unless (eq? (continuation-mark-set-first #f prop:chaperone-unsafe-undefined)
|
||||
unsafe-undefined)
|
||||
(raise-unsafe-undefined 'struct-set! "assignment disallowed" "assign" set (impersonator-val v) abs-pos)))
|
||||
(loop (impersonator-next v) a)]
|
||||
[(impersonator? v)
|
||||
(loop (impersonator-next v) a)]
|
||||
[else (set v a)])))]
|
||||
[else
|
||||
;; Equivalent to `(set v a)`:
|
||||
(unsafe-struct*-set! v abs-pos a)])))]
|
||||
[else
|
||||
(raise-argument-error (string->symbol
|
||||
(string-append "set"
|
||||
|
|
@ -347,41 +370,38 @@
|
|||
"value" v))
|
||||
(let loop ([first? (not st)]
|
||||
[args orig-args]
|
||||
[props empty-hash]
|
||||
[saw-props empty-hash]
|
||||
[props empty-hasheq]
|
||||
[saw-props empty-hasheq]
|
||||
[witnessed? (and st #t)]
|
||||
[iprops orig-iprops])
|
||||
(let ([get-proc
|
||||
(lambda (what args arity proc->key key-applies?)
|
||||
(let* ([orig-proc (car args)]
|
||||
[key-proc (strip-impersonator orig-proc)]
|
||||
[key (proc->key key-proc)])
|
||||
(when (hash-ref saw-props key #f)
|
||||
(raise-arguments-error who
|
||||
"given operation accesses the same value as a previous operation argument"
|
||||
"operation kind" what
|
||||
"operation procedure" orig-proc))
|
||||
(when key-applies?
|
||||
(unless (key-applies? key val)
|
||||
(lambda (what args arity orig-proc key1 key2 key-applies? now-witnessed?)
|
||||
(unless key-applies?
|
||||
(raise-arguments-error who
|
||||
"operation does not apply to given value"
|
||||
"operation kind" what
|
||||
"operation kind" (make-unquoted-printing-string what)
|
||||
"operation procedure" orig-proc
|
||||
"value" v)))
|
||||
"value" v))
|
||||
(when (hash-ref2 saw-props key1 key2 #f)
|
||||
(raise-arguments-error who
|
||||
"given operation accesses the same value as a previous operation argument"
|
||||
"operation kind" (make-unquoted-printing-string what)
|
||||
"operation procedure" orig-proc))
|
||||
(when (null? (cdr args))
|
||||
(raise-arguments-error who
|
||||
"missing redirection procedure after operation"
|
||||
"operation kind" what
|
||||
"operation kind" (make-unquoted-printing-string what)
|
||||
"operation procedure" orig-proc))
|
||||
(let ([proc (cadr args)])
|
||||
(when proc
|
||||
(unless (procedure-arity-includes? proc arity)
|
||||
(unless (unsafe-procedure-and-arity-includes? proc arity)
|
||||
(raise-arguments-error who
|
||||
"operation's redirection procedure does not match the expected arity"
|
||||
"given" proc
|
||||
"expected" (string-append
|
||||
"(or/c #f (procedure-arity-includes/c " (number->string arity) "))")
|
||||
"operation kind" what
|
||||
"expected" (make-unquoted-printing-string
|
||||
(string-append
|
||||
"(or/c #f (procedure-arity-includes/c " (number->string arity) "))"))
|
||||
"operation kind" (make-unquoted-printing-string what)
|
||||
"operation procedure" orig-proc)))
|
||||
(when (and as-chaperone?
|
||||
(and (impersonator? orig-proc)
|
||||
|
|
@ -389,17 +409,18 @@
|
|||
(raise-arguments-error who
|
||||
"impersonated operation cannot be used to create a chaperone"
|
||||
"operation" orig-proc))
|
||||
(let ([new-args (cddr args)])
|
||||
(loop #f
|
||||
(cddr args)
|
||||
new-args
|
||||
(if proc
|
||||
(hash-set props key
|
||||
(hash-set2 props key1 key2
|
||||
(if (impersonator? orig-proc)
|
||||
(cons orig-proc ; save original accessor, in case it's impersonated
|
||||
proc) ; the interposition proc
|
||||
proc))
|
||||
props)
|
||||
(hash-set saw-props key #t)
|
||||
(or witnessed? key-applies?)
|
||||
(if (null? new-args) saw-props (hash-set2 saw-props key1 key2 #t))
|
||||
(or witnessed? now-witnessed?)
|
||||
iprops))))])
|
||||
(cond
|
||||
[(null? args)
|
||||
|
|
@ -422,7 +443,7 @@
|
|||
" instance of an authentic structure type")
|
||||
"given value" v))
|
||||
(cond
|
||||
[(zero? (hash-count props))
|
||||
[(eq? props empty-hasheq)
|
||||
;; No structure operations chaperoned, so either unchanged or
|
||||
;; a properties-only impersonator
|
||||
(cond
|
||||
|
|
@ -463,39 +484,46 @@
|
|||
witnessed?
|
||||
(add-impersonator-properties who args iprops))]
|
||||
[(struct-accessor-procedure? (car args))
|
||||
(get-proc "accessor" args 2
|
||||
struct-accessor-procedure-rtd+pos
|
||||
(lambda (rtd+pos v)
|
||||
(and (record? v (car rtd+pos))
|
||||
(begin
|
||||
(let* ([orig-proc (car args)]
|
||||
[key-proc (strip-impersonator orig-proc)]
|
||||
[rtd+pos (struct-accessor-procedure-rtd+pos key-proc)])
|
||||
(unless (or as-chaperone?
|
||||
(struct-type-field-mutable? (car rtd+pos) (cdr rtd+pos)))
|
||||
(raise-arguments-error who
|
||||
"cannot replace operation for an immutable field"
|
||||
"operation kind" "property accessor"
|
||||
"operation kind" (make-unquoted-printing-string "property accessor")
|
||||
"operation procedure" (car args)))
|
||||
#t))))]
|
||||
(get-proc "accessor" args 2
|
||||
orig-proc (car rtd+pos) (cdr rtd+pos)
|
||||
(record? val (car rtd+pos))
|
||||
#t))]
|
||||
[(struct-mutator-procedure? (car args))
|
||||
(let* ([orig-proc (car args)]
|
||||
[key-proc (strip-impersonator orig-proc)]
|
||||
[rtd+pos (struct-mutator-procedure-rtd+pos key-proc)])
|
||||
(get-proc "mutator" args 2
|
||||
(lambda (proc)
|
||||
(let ([rtd+pos (struct-mutator-procedure-rtd+pos proc)])
|
||||
(vector (car rtd+pos) (cdr rtd+pos))))
|
||||
(lambda (rtd++pos v)
|
||||
(record? v (vector-ref rtd++pos 0))))]
|
||||
orig-proc (car rtd+pos) (struct-mutator-pos->key2 (cdr rtd+pos))
|
||||
(record? val (car rtd+pos))
|
||||
#t))]
|
||||
[(struct-type-property-accessor-procedure? (car args))
|
||||
(get-proc "property accessor" args 2
|
||||
(lambda (proc) proc)
|
||||
(lambda (proc v)
|
||||
(let* ([orig-proc (car args)]
|
||||
[key-proc (strip-impersonator orig-proc)])
|
||||
(unless (or as-chaperone?
|
||||
(struct-type-property-accessor-procedure-can-impersonate? proc))
|
||||
(struct-type-property-accessor-procedure-can-impersonate? key-proc))
|
||||
(raise-arguments-error who
|
||||
"operation cannot be impersonated"
|
||||
"operation kind" "property accessor"
|
||||
"operation procedure" (car args)))
|
||||
((struct-type-property-accessor-procedure-pred proc) v)))]
|
||||
"operation kind" (make-unquoted-printing-string "property accessor")
|
||||
"operation procedure" orig-proc))
|
||||
(get-proc "property accessor" args 2
|
||||
orig-proc key-proc #f
|
||||
((struct-type-property-accessor-procedure-pred key-proc) val)
|
||||
#t))]
|
||||
[(and as-chaperone?
|
||||
(equal? struct-info (car args)))
|
||||
(get-proc "struct-info procedure" args 2 (lambda (proc) proc) #f)]
|
||||
(get-proc "struct-info procedure" args 2
|
||||
struct-info struct-info #f
|
||||
#t
|
||||
#f)]
|
||||
[else
|
||||
(raise-argument-error who
|
||||
(string-append
|
||||
|
|
|
|||
|
|
@ -82,7 +82,7 @@
|
|||
(cond
|
||||
[(and (impersonator? v)
|
||||
(pred v))
|
||||
(impersonate-struct-or-property-ref acc #f acc v #f #f)]
|
||||
(impersonate-struct-or-property-ref acc #f #|key1:|# acc #|key2:|# #f v #f #f)]
|
||||
[else
|
||||
(let* ([rtd (if (record-type-descriptor? v)
|
||||
v
|
||||
|
|
@ -406,38 +406,38 @@
|
|||
(define (struct-constructor-procedure? v)
|
||||
(and (procedure? v)
|
||||
(let ([v (strip-impersonator v)])
|
||||
(with-global-lock* (hashtable-ref struct-constructors v #f)))))
|
||||
(with-global-lock* (eq-hashtable-ref struct-constructors v #f)))))
|
||||
|
||||
(define (struct-predicate-procedure? v)
|
||||
(and (procedure? v)
|
||||
(let ([v (strip-impersonator v)])
|
||||
(with-global-lock* (hashtable-ref struct-predicates v #f)))))
|
||||
(with-global-lock* (eq-hashtable-ref struct-predicates v #f)))))
|
||||
|
||||
(define (struct-accessor-procedure? v)
|
||||
(and (procedure? v)
|
||||
(let ([v (strip-impersonator v)])
|
||||
(or (position-based-accessor? v)
|
||||
(with-global-lock* (hashtable-ref struct-field-accessors v #f))))
|
||||
(with-global-lock* (eq-hashtable-ref struct-field-accessors v #f))))
|
||||
#t))
|
||||
|
||||
(define (struct-mutator-procedure? v)
|
||||
(and (procedure? v)
|
||||
(let ([v (strip-impersonator v)])
|
||||
(or (position-based-mutator? v)
|
||||
(with-global-lock* (hashtable-ref struct-field-mutators v #f))))
|
||||
(with-global-lock* (eq-hashtable-ref struct-field-mutators v #f))))
|
||||
#t))
|
||||
|
||||
(define (struct-accessor-procedure-rtd+pos v)
|
||||
(if (position-based-accessor? v)
|
||||
(cons (position-based-accessor-rtd v)
|
||||
(position-based-accessor-offset v))
|
||||
(with-global-lock* (hashtable-ref struct-field-accessors v #f))))
|
||||
(with-global-lock* (eq-hashtable-ref struct-field-accessors v #f))))
|
||||
|
||||
(define (struct-mutator-procedure-rtd+pos v)
|
||||
(if (position-based-mutator? v)
|
||||
(cons (position-based-mutator-rtd v)
|
||||
(position-based-mutator-offset v))
|
||||
(with-global-lock* (hashtable-ref struct-field-mutators v #f))))
|
||||
(with-global-lock* (eq-hashtable-ref struct-field-mutators v #f))))
|
||||
|
||||
;; This indirection prevents the whole-program optimizer from inlining
|
||||
;; the `with-glocal-lock*` expansion --- which, at the time of
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user