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

cp0: reductions for $record-ref

Browse Source 
original commit: 8a04158ef995388ffcdfb369d6cfaf4ec384408d
This commit is contained in:
Gustavo Massaccesi 2019-04-15 17:59:22 -03:00
parent eb998e34f2
commit 03214b9bdb
3 changed files with 138 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

111
mats/record.ms
View File

@ -9044,3 +9044,114 @@
(#2%list #t #t)
(#2%list #f (#2%record-type-sealed? rtd))))))
)
(mat cp0-kar-kons-$record-ref-optimizations
(eq? (let ()
(define-record kons (kar kdr))
(#3%$record-ref (make-kons 'a 'b) 0))
'a)
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-record kons (kar kdr))
(#3%$record-ref (make-kons 'a 'b) 0))))
''a)
(eq? (let ()
(define-record kons (kar kdr))
(#3%$record-ref (make-kons 'a 'b) 1))
'b)
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-record kons (kar kdr))
(#3%$record-ref (make-kons 'a 'b) 1))))
''b)
(equal?
(with-output-to-string
(lambda ()
(define-record kons (kar kdr))
(display (#3%$record-ref (make-kons (begin (display 1) (display 2) 3)
(begin (display 4) (display 5) 6))
0))))
"45123") ;"12453" is also correct
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-record kons (kar kdr))
(display (#3%$record-ref (make-kons (begin (display 1) (display 2) 3)
(begin (display 4) (display 5) 6))
0)))))
'(#2%display
(begin
(#2%display 4)
(#2%display 5)
(#2%display 1)
(#2%display 2)
3)))
(equal?
(with-output-to-string
(lambda ()
(define-record kons (kar kdr))
(display (#3%$record-ref (make-kons (begin (display 1) (display 2) 3)
(begin (display 4) (display 5) 6))
1))))
"45126") ;"12456" is also correct
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-record kons (kar kdr))
(display (#3%$record-ref (make-kons (begin (display 1) (display 2) 3)
(begin (display 4) (display 5) 6))
1)))))
'(#2%display
(begin
(#2%display 4)
(#2%display 5)
(#2%display 1)
(#2%display 2)
6)))
(equal?
(with-output-to-string
(lambda ()
(define-record kons (kar kdr))
(display (#3%$record-ref (begin (display 1) (make-kons 2 3))
(begin (display 4) 0)))))
"412") ;"142" is also correct
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-record kons (kar kdr))
(display (#3%$record-ref (begin (display 1) (make-kons 2 3))
(begin (display 4) 0))))))
'(#2%display
(begin
(#2%display 4)
(#2%display 1)
2)))
(equal?
(with-output-to-string
(lambda ()
(define-record kons (kar kdr))
(display (#3%$record-ref (begin (display 1) (make-kons 2 3))
(begin (display 4) 1)))))
"413") ;"143" is also correct
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(let ()
(define-record kons (kar kdr))
(display (#3%$record-ref (begin (display 1) (make-kons 2 3))
(begin (display 4) 1))))))
'(#2%display
(begin
(#2%display 4)
(#2%display 1)
3)))
)

26
s/cp0.ss
View File

@ -3828,6 +3828,32 @@
`(record ,rtd ,rtd-expr ,(map value-visit-operand! ?e*) ...))]
[else #f]))])
(define-inline 3 $record-ref
[(?r ?i)
(let ([i-expr (value-visit-operand! ?i)])
(nanopass-case (Lsrc Expr) (result-exp i-expr)
[(quote ,d)
(guard (and (fixnum? d) (fx>= d 0)))
(let ([r-expr (value-visit-operand! ?r)])
(nanopass-case (Lsrc Expr) (result-exp r-expr)
[(record ,rtd1 ,rtd-expr1 ,e* ...)
(let loop ([e* e*] [re* '()] [index d])
(and (not (null? e*))
(if (fx= index 0)
(let ([e (car e*)] [e* (rappend re* (cdr e*))])
(define main (if (null? e*)
(make-nontail ctxt e)
(make-1seq ctxt
(make-seq* 'ignored e*)
(make-nontail ctxt e))))
(residualize-seq (list ?r ?i) '() ctxt)
(non-result-exp i-expr
(non-result-exp r-expr
main)))
(loop (cdr e*) (cons (car e*) re*) (fx- index 1)))))]
[else #f]))]
[else #f]))])
(let ()
(define null-rec?
(lambda (?ls)

2
s/primdata.ss
View File

@ -2197,7 +2197,7 @@
($record-equal-procedure [flags discard])
($record-hash-procedure [flags discard])
($record-oops #;[sig [(who sub-ptr rtd) -> (bottom)]] [flags abort-op])
($record-ref [sig [(ptr sub-index) -> (ptr)]] [flags mifoldable discard])
($record-ref [sig [(ptr sub-index) -> (ptr)]] [flags mifoldable discard cp03])
($record-set! [sig [(ptr sub-index ptr) -> (void)]] [flags true])
($record-type-descriptor [flags pure mifoldable discard true])
($record-type-field-offsets [flags pure mifoldable discard true])