suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

racket/class: mark internal wrapped-object as authentic

Browse Source 
Combined with a schemify improvement that inlines imported predicates
to expose the record-type test to Chez Scheme, this chage enables
cptypes to prune useless inlined `wrapped-object` selector branches.
That improvement, in turn, reduces code size and redundant checks on
objects that have contracts.
This commit is contained in:
Matthew Flatt 2020-02-17 10:51:50 -07:00
parent c7059c7c94
commit 3519f8f3fc
5 changed files with 44 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
racket/collects/racket/private/class-wrapped.rkt
View File

@ -20,6 +20,7 @@
(struct wrapped-object (object neg-extra-arg-vec pos-field-projs neg-field-projs neg-party)
#:transparent
#:authentic
#:property prop:custom-write
(λ (stct port mode)
(do-custom-write (wrapped-object-object stct) port mode)))

4
racket/src/schemify/find-definition.rkt
View File

@ -47,7 +47,7 @@
a-known-constant))]
[knowns (hash-set knowns
(unwrap s?)
(known-predicate 2 type))]
(known-struct-predicate 2 type struct:s (struct-type-info-authentic? info)))]
[knowns
(let* ([immediate-count (struct-type-info-immediate-field-count info)]
[parent-count (- (struct-type-info-field-count info)
@ -87,7 +87,7 @@
a-known-constant))]
[knowns (hash-set knowns
(unwrap s?)
(known-predicate 2 type))])
(known-struct-predicate 2 type struct:s (struct-type-info-authentic? info)))])
;; For now, we don't try to track the position-consuming accessor or mutator
(hash-set knowns (unwrap struct:s) (known-struct-type type
(struct-type-info-field-count info)

18
racket/src/schemify/inline.rkt
View File

@ -88,6 +88,8 @@
(define (inline-type-id k im add-import! mutated imports)
(define type-id (cond
[(known-struct-predicate? k)
(known-struct-predicate-type-id k)]
[(known-field-accessor? k)
(known-field-accessor-type-id k)]
[(known-field-mutator? k)
@ -99,6 +101,10 @@
(cond
[(not type-id) #f]
[(not im) '()]
[(known-struct-predicate/need-imports? k)
(needed->env (known-struct-predicate/need-imports-needed k)
add-import!
im)]
[(known-field-accessor/need-imports? k)
(needed->env (known-field-accessor/need-imports-needed k)
add-import!
@ -233,6 +239,18 @@
(known-procedure-arity-mask k)
(if serializable? (wrap-truncate-paths expr) expr)
(needed->list needed))])]
[(known-struct-predicate? k)
(define needed (needed-imports (known-struct-predicate-type-id k) prim-knowns imports exports '() '#hasheq()))
(cond
[needed
(known-struct-predicate/need-imports (known-procedure-arity-mask k)
(known-predicate-type k)
(known-struct-predicate-type-id k)
(known-struct-predicate-authentic? k)
(needed->list needed))]
[else
(known-predicate (known-procedure-arity-mask k)
(known-predicate-type k))])]
[(known-field-accessor? k)
(define needed (needed-imports (known-field-accessor-type-id k) prim-knowns imports exports '() '#hasheq()))
(cond

4
racket/src/schemify/known.rkt
View File

@ -30,8 +30,10 @@
known-predicate known-predicate? known-predicate-type
known-accessor known-accessor? known-accessor-type
known-mutator known-mutator? known-mutator-type
known-struct-predicate known-struct-predicate? known-struct-predicate-type-id known-struct-predicate-authentic?
known-field-accessor known-field-accessor? known-field-accessor-type-id known-field-accessor-pos
known-field-mutator known-field-mutator? known-field-mutator-type-id known-field-mutator-pos
known-struct-predicate/need-imports known-struct-predicate/need-imports? known-struct-predicate/need-imports-needed
known-field-accessor/need-imports known-field-accessor/need-imports? known-field-accessor/need-imports-needed
known-field-mutator/need-imports known-field-mutator/need-imports? known-field-mutator/need-imports-needed
known-struct-type-property/immediate-guard known-struct-type-property/immediate-guard?
@ -100,8 +102,10 @@
(struct known-predicate (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure/pure)
(struct known-accessor (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure)
(struct known-mutator (type) #:prefab #:omit-define-syntaxes #:super struct:known-procedure)
(struct known-struct-predicate (type-id authentic?) #:prefab #:omit-define-syntaxes #:super struct:known-predicate)
(struct known-field-accessor (type-id pos) #:prefab #:omit-define-syntaxes #:super struct:known-accessor)
(struct known-field-mutator (type-id pos) #:prefab #:omit-define-syntaxes #:super struct:known-mutator)
(struct known-struct-predicate/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-struct-predicate)
(struct known-field-accessor/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-field-accessor)
(struct known-field-mutator/need-imports (needed) #:prefab #:omit-define-syntaxes #:super struct:known-field-mutator)

19
racket/src/schemify/schemify.rkt
View File

@ -797,6 +797,21 @@
body
`(let ([,tmp ,e])
,body)))
(define (inline-struct-predicate k s-rator im args)
;; For imported predicates on authentic structure types, it's worth
;; inlining the predicate to enable cptypes optimizations.
(define type-id (and im
(known-struct-predicate-authentic? k)
(pair? args)
(null? (cdr args))
(inline-type-id k im add-import! mutated imports)))
(cond
[type-id
(define tmp (maybe-tmp (car args) 'v))
(define ques `(unsafe-struct? ,tmp ,(schemify type-id 'fresh)))
(wrap-tmp tmp (car args)
ques)]
[else #f]))
(define (inline-field-access k s-rator im args)
;; For imported accessors or for JIT mode, inline the
;; selector with an `unsafe-struct?` test plus `unsafe-struct*-ref`.
@ -845,6 +860,10 @@
(cdr e)
#t for-cify?
prim-knowns knowns imports mutated simples))]
[(and (not for-cify?)
(known-struct-predicate? k)
(inline-struct-predicate k s-rator im args))
=> (lambda (e) e)]
[(and (not for-cify?)
(known-field-accessor? k)
(inline-field-access k s-rator im args))