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

reverted to the preceding version of cp0 due to failure to preserve

Browse Source 
the expected evaluation order in one of the mats; removed the
corresponding equivalent-expansion tests.
  cp0.ss,
  4.ms
rebuild boot files

original commit: 63c6ae5c2d4354a984bfc210f061c2c2123f0439
This commit is contained in:
dyb 2017-06-08 01:06:29 -04:00
parent de8929221f
commit 74f0518c89
3 changed files with 131 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
LOG
View File

@ -484,3 +484,8 @@
explicit lists like (list 1 2 3 ...) or '(1 2 3 ...).
cp0.ss,
4.ms
- reverted to the preceding version of cp0 due to failure to preserve
the expected evaluation order in one of the mats; removed the
corresponding equivalent-expansion tests.
cp0.ss,
4.ms

64
mats/4.ms
View File

@ -1120,30 +1120,6 @@
(list 4 5 6)
(list '(7) '(8) '(9)))))
'(#3%list 12 15 18))
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(map (lambda (x y z) (apply + x y z))
'(1 2 3)
(list 4 5 6)
(list '(7) '(8) '(9)))))
'(#2%list 12 15 18))
(equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(map (lambda (x y z) (apply + x y z))
'(1 2 3)
(list 4 5 6)
(list '(7) '(8) '(9)))))
'(#3%list 12 15 18))
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(map (lambda (x y z) (apply + x y z))
'(1 2 3)
'(4 5 6)
'((7) (8) (9)))))
'(#2%list 12 15 18))
(equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
@ -1948,46 +1924,6 @@
'(#2%void)))
;; for-each with lambda exp as procedure and lists in the form (list e0 e1 ... en) or '(e0 e1 ... en)
;; avoid creating each list and doing the actual for-each
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(for-each (lambda (x y z) (display (apply + x y z)))
(list 1 2 3)
(list 4 5 6)
(list '(7) '(8) '(9)))))
'(begin (#2%display 12) (#2%display 15) (#2%display 18)))
(equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(for-each (lambda (x y z) (display (apply + x y z)))
(list 1 2 3)
(list 4 5 6)
(list '(7) '(8) '(9)))))
'(begin (#3%display 12) (#3%display 15) (#3%display 18)))
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(for-each (lambda (x y z) (display (apply + x y z)))
'(1 2 3)
(list 4 5 6)
(list '(7) '(8) '(9)))))
'(begin (#2%display 12) (#2%display 15) (#2%display 18)))
(equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(for-each (lambda (x y z) (display (apply + x y z)))
'(1 2 3)
(list 4 5 6)
(list '(7) '(8) '(9)))))
'(begin (#3%display 12) (#3%display 15) (#3%display 18)))
(equivalent-expansion?
(parameterize ([optimize-level 2] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize
'(for-each (lambda (x y z) (display (apply + x y z)))
'(1 2 3)
'(4 5 6)
'((7) (8) (9)))))
'(begin (#2%display 12) (#2%display 15) (#2%display 18)))
(equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize

62
s/cp0.ss
View File

@ -3565,26 +3565,21 @@
(lambda (?ls)
(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls))
[(quote ,d) (null? d)]
[(call ,preinfo ,e ,e* ...)
; check also for `(list)`. It should have been reduced to `(quote ())` before,
; but cp0 isn't guaranteed to reach a fixed point.
(and (primref? e) (eq? (primref-name e) 'list) (null? e*))]
[else #f])))
(define inline-lists
(lambda (?p ?ls ?ls* lvl map? ctxt sc wd name moi)
; (map/for-each proc (list a11 a12 ... a1m) (list a21 a22 ... a2m) ... (list an1 an2 ... anm)) =>
(lambda (?p ?ls ?ls* lvl ctxt sc wd name moi)
; (map proc (list a11 a12 ... a1m) (list a21 a22 ... a2m) ... (list an1 an2 ... anm)) =>
; (let ([p proc])
; (let ([t21 a21] [t22 a22] ... [t2m a2m])
; ...
; (let ([tn1 an1] [tn2 an2] ... [tnm anm])
; (list/begin (p a11 t21 ... tn1)
; (list (p a11 t21 ... tn1)
; (p a12 t22 ... tn2)
; ...
; (p a1m t2m ... tnm)))))
(let loop ([ls* (cons ?ls ?ls*)] [e** '()] [all-quoted? #t])
(let loop ([ls* (cons ?ls ?ls*)] [e** '()])
(if (null? ls*)
(and (apply = (map length e**))
(or (not all-quoted?) (fx<= (length (car e**)) 4))
(let* ([e** (reverse e**)] [e* (car e**)] [e** (cdr e**)])
(residualize-seq (list* ?p ?ls ?ls*) '() ctxt)
(let ([p (cp0-make-temp (fx> (length e*) 1))]
@ -3595,25 +3590,20 @@
(let f ([t** temp**] [e** e**] [ls* ?ls*])
(if (null? t**)
(non-result-exp (value-visit-operand! ?ls)
(let ([results
(build-primcall lvl 'list
(let ([preinfo (app-preinfo ctxt)])
(let g ([e* e*] [t** temp**])
(if (null? e*)
'()
(cons `(call ,preinfo (ref #f ,p) ,(car e*)
,(map (lambda (t*) (build-ref (car t*))) t**) ...)
(g (cdr e*) (map cdr t**))))))])
(if map?
(build-primcall lvl 'list results)
(make-seq* ctxt results))))
(g (cdr e*) (map cdr t**))))))))
(non-result-exp (value-visit-operand! (car ls*))
(build-let (car t**) (car e**)
(f (cdr t**) (cdr e**) (cdr ls*))))))))))
(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! (car ls*)))
[(quote ,d)
(and (list? d) (loop (cdr ls*) (cons (map (lambda (x) `(quote ,x)) d) e**) all-quoted?))]
[(call ,preinfo ,e ,e* ...)
(and (primref? e) (eq? (primref-name e) 'list) (loop (cdr ls*) (cons e* e**) #f))]
(and (primref? e) (eq? (primref-name e) 'list) (loop (cdr ls*) (cons e* e**)))]
[else #f])))))
(define-inline 2 map
[(?p ?ls . ?ls*)
@ -3621,13 +3611,14 @@
(begin
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
null-rec)
(inline-lists ?p ?ls ?ls* 2 #t ctxt sc wd name moi))])
(inline-lists ?p ?ls ?ls* 2 ctxt sc wd name moi))])
(define-inline 3 map
[(?p ?ls . ?ls*)
(cond
[(ormap null-rec? (cons ?ls ?ls*))
(begin
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
null-rec]
null-rec)]
; could treat map in effect context as for-each, but don't because (our)
; map is guaranteed (even at optimization level 3) not to get sick if an
; input list is mutated, while for-each is not.
@ -3637,18 +3628,15 @@
(and (if (all-set? (prim-mask unsafe) flags)
(all-set? (prim-mask discard) flags)
(all-set? (prim-mask (or discard unrestricted)) flags))
(arity-okay? (primref-arity pr) (fx+ (length ?ls*) 1))))]
(arity-okay? (primref-arity pr) (+ (length ?ls*) 1))))]
[else #f]))
; discard effect-free calls to map in effect context
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec]
[(inline-lists ?p ?ls ?ls* 3 #t ctxt sc wd name moi)]
[(ormap (lambda (?ls)
(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls))
[(quote ,d)
(and (list? d) (let ([n (length d)]) (and (fx<= n 4) n)))]
[(call ,preinfo ,e ,e* ...)
(and (primref? e) (eq? (primref-name e) 'list) (let ([n (length e*)]) (and (fx<= n 4) n)))]
[else #f]))
(cons ?ls ?ls*)) =>
(lambda (n)
@ -3693,7 +3681,7 @@
ls*) ...)
ropnd*))))))))
ctxt empty-env sc wd name moi))]
[else #f])])
[else (inline-lists ?p ?ls ?ls* 3 ctxt sc wd name moi)])])
(define-inline 2 for-each
[(?p ?ls . ?ls*)
@ -3701,37 +3689,34 @@
[(andmap null-rec? (cons ?ls ?ls*))
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec]
[else
(inline-lists ?p ?ls ?ls* 2 #f ctxt sc wd name moi)])])
[else #f])])
)
(define-inline 3 for-each
[(?p ?ls . ?ls*)
(cond
[(ormap null-rec? (cons ?ls ?ls*))
; (for-each proc e1 ... (begin e2 ... '()) e3 ...) =>
; (begin e1 ... (begin e2 ... '()) e3 ... (void))
(begin
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec)]
[(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?p))
[,pr (let ([flags (primref-flags pr)])
(and (if (all-set? (prim-mask unsafe) flags)
(all-set? (prim-mask discard) flags)
(all-set? (prim-mask (or discard unrestricted)) flags))
(arity-okay? (primref-arity pr) (fx+ (length ?ls*) 1))))]
(arity-okay? (primref-arity pr) (+ (length ?ls*) 1))))]
[else #f])
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec]
[(inline-lists ?p ?ls ?ls* 3 #f ctxt sc wd name moi)]
[(ormap (lambda (?ls)
(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls))
[(quote ,d)
(and (list? d) (let ([n (length d)]) (and (fx<= n 4) n)))]
[(call ,preinfo ,e ,e* ...)
(and (primref? e) (eq? (primref-name e) 'list) (let ([n (length e*)]) (and (fx<= n 4) n)))]
[else #f]))
(cons ?ls ?ls*)) =>
(lambda (n)
(safe-assert (not (= n 0))) ; guaranteed before we get here
(cond
[(fx= n 0)
; (for-each proc e1 ... (begin e2 ... '()) e3 ...) =>
; (begin e1 ... (begin e2 ... '()) e3 ... (void))
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec]
[else
; (for-each proc e1 ... (begin e2 ... '(a b c d)) e3 ...)
; ((lambda (p ls ...)
; (proc (car ls) ...)
@ -3775,7 +3760,7 @@
(build-primcall 3 'cdr (list (build-ref x))))
ls*)
(f (fx- n 1) tls*))))))])))
ctxt empty-env sc wd name moi))]
ctxt empty-env sc wd name moi)]))]
[else
(and likely-to-be-compiled?
(cp0
@ -3808,7 +3793,6 @@
(build-primcall 3 'cdr (list (build-ref x))))
(cdr ls*)) ...)))))))))
ctxt empty-env sc wd name moi))])])
)
(define-inline 3 vector-map
[(?p ?v . ?v*)