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

- restored the map and for-each optimizations with a fix for the

Browse Source 
evaluation-order bug.
    cp0.ss,
    4.ms

original commit: b395a763a3167c6a044273ea7deb000de35b0f09
This commit is contained in:
dyb 2017-06-08 02:43:14 -04:00
parent 74f0518c89
commit a004a67b3f
9 changed files with 267 additions and 151 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
LOG
View File

@ -489,3 +489,7 @@
corresponding equivalent-expansion tests. corresponding equivalent-expansion tests.
cp0.ss, cp0.ss,
4.ms 4.ms
- restored the map and for-each optimizations with a fix for the
evaluation-order bug.
cp0.ss,
4.ms

64
mats/4.ms
View File

@ -1120,6 +1120,30 @@
(list 4 5 6) (list 4 5 6)
(list '(7) '(8) '(9))))) (list '(7) '(8) '(9)))))
'(#3%list 12 15 18)) '(#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? (equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f]) (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize (expand/optimize
@ -1924,6 +1948,46 @@
'(#2%void))) '(#2%void)))
;; for-each with lambda exp as procedure and lists in the form (list e0 e1 ... en) or '(e0 e1 ... en) ;; 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 ;; 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? (equivalent-expansion?
(parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f]) (parameterize ([optimize-level 3] [enable-cp0 #t] [#%$suppress-primitive-inlining #f])
(expand/optimize (expand/optimize

38
mats/patch-compile-0-f-t-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-f-f 2017-05-29 03:04:27.000000000 -0400 *** errors-compile-0-f-f-f 2017-06-08 02:10:03.000000000 -0400
--- errors-compile-0-f-t-f 2017-05-29 02:30:33.000000000 -0400 --- errors-compile-0-f-t-f 2017-06-08 01:38:37.000000000 -0400
*************** ***************
*** 125,131 **** *** 125,131 ****
3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a". 3.mo:Expected error in mat dipa-letrec: "attempt to reference undefined variable a".
@ -58,6 +58,40 @@
3.mo:Expected error in mat mrvs: "attempt to apply non-procedure 17". 3.mo:Expected error in mat mrvs: "attempt to apply non-procedure 17".
3.mo:Expected error in mat mrvs: "returned two values to single value return context". 3.mo:Expected error in mat mrvs: "returned two values to single value return context".
*************** ***************
*** 249,255 ****
4.mo:Expected error in mat r6rs:case: "invalid syntax (r6rs:case (quote a) (a (quote yes)) (b (quote no)))".
4.mo:Expected error in mat r6rs:case: "invalid syntax (case (quote a) (a (quote yes)) (b (quote no)))".
4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".
! 4.mo:Expected error in mat map: "map: 3 is not a procedure".
4.mo:Expected error in mat map: "map: a is not a proper list".
4.mo:Expected error in mat map: "map: (a . b) is not a proper list".
4.mo:Expected error in mat map: "map: (a a a a a a ...) is circular".
--- 249,255 ----
4.mo:Expected error in mat r6rs:case: "invalid syntax (r6rs:case (quote a) (a (quote yes)) (b (quote no)))".
4.mo:Expected error in mat r6rs:case: "invalid syntax (case (quote a) (a (quote yes)) (b (quote no)))".
4.mo:Expected error in mat named-let: "incorrect argument count in call ((letrec ((...)) x) 3 4)".
! 4.mo:Expected error in mat map: "attempt to apply non-procedure 3".
4.mo:Expected error in mat map: "map: a is not a proper list".
4.mo:Expected error in mat map: "map: (a . b) is not a proper list".
4.mo:Expected error in mat map: "map: (a a a a a a ...) is circular".
***************
*** 319,325 ****
4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
! 4.mo:Expected error in mat for-each: "for-each: 3 is not a procedure".
4.mo:Expected error in mat for-each: "for-each: a is not a proper list".
4.mo:Expected error in mat for-each: "for-each: (a . b) is not a proper list".
4.mo:Expected error in mat for-each: "for-each: (a a a a a a ...) is circular".
--- 319,325 ----
4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
4.mo:Expected error in mat fold-right: "fold-right: (a a a a a a ...) is circular".
! 4.mo:Expected error in mat for-each: "attempt to apply non-procedure 3".
4.mo:Expected error in mat for-each: "for-each: a is not a proper list".
4.mo:Expected error in mat for-each: "for-each: (a . b) is not a proper list".
4.mo:Expected error in mat for-each: "for-each: (a a a a a a ...) is circular".
***************
*** 3645,3651 **** *** 3645,3651 ****
misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"". misc.mo:Expected error in mat cpletrec: "foreign-procedure: no entry for "foo"".
misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q". misc.mo:Expected error in mat cpletrec: "attempt to reference undefined variable q".

4
mats/patch-compile-0-t-f-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-f-f 2017-05-29 03:04:27.000000000 -0400 *** errors-compile-0-f-f-f 2017-06-08 02:10:03.000000000 -0400
--- errors-compile-0-t-f-f 2017-05-29 02:38:26.000000000 -0400 --- errors-compile-0-t-f-f 2017-06-08 01:45:53.000000000 -0400
*************** ***************
*** 93,99 **** *** 93,99 ****
3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>". 3.mo:Expected error in mat case-lambda: "incorrect number of arguments to #<procedure foo>".

4
mats/patch-interpret-0-f-f-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-f-f 2017-05-29 03:04:27.000000000 -0400 *** errors-compile-0-f-f-f 2017-06-08 02:10:03.000000000 -0400
--- errors-interpret-0-f-f-f 2017-05-29 02:47:10.000000000 -0400 --- errors-interpret-0-f-f-f 2017-06-08 01:53:14.000000000 -0400
*************** ***************
*** 1,7 **** *** 1,7 ****
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure". primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".

4
mats/patch-interpret-0-f-t-f
View File

@ -1,5 +1,5 @@
*** errors-compile-0-f-t-f 2017-05-29 02:30:33.000000000 -0400 *** errors-compile-0-f-t-f 2017-06-08 01:38:37.000000000 -0400
--- errors-interpret-0-f-t-f 2017-05-29 02:54:57.000000000 -0400 --- errors-interpret-0-f-t-f 2017-06-08 02:00:50.000000000 -0400
*************** ***************
*** 1,7 **** *** 1,7 ****
primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure". primvars.mo:Expected error in mat make-parameter: "make-parameter: 2 is not a procedure".

4
mats/patch-interpret-3-f-f-f
View File

@ -1,5 +1,5 @@
*** errors-compile-3-f-f-f 2017-05-29 02:26:29.000000000 -0400 *** errors-compile-3-f-f-f 2017-06-08 01:35:00.000000000 -0400
--- errors-interpret-3-f-f-f 2017-05-29 03:10:12.000000000 -0400 --- errors-interpret-3-f-f-f 2017-06-08 02:15:41.000000000 -0400
*************** ***************
*** 1,3 **** *** 1,3 ****
--- 1,9 ---- --- 1,9 ----

4
mats/patch-interpret-3-f-t-f
View File

@ -1,5 +1,5 @@
*** errors-compile-3-f-t-f 2017-05-29 02:34:27.000000000 -0400 *** errors-compile-3-f-t-f 2017-06-08 01:42:09.000000000 -0400
--- errors-interpret-3-f-t-f 2017-05-29 02:58:45.000000000 -0400 --- errors-interpret-3-f-t-f 2017-06-08 02:04:33.000000000 -0400
*************** ***************
*** 1,3 **** *** 1,3 ****
--- 1,9 ---- --- 1,9 ----

292
s/cp0.ss
View File

@ -3565,45 +3565,53 @@
(lambda (?ls) (lambda (?ls)
(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls)) (nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls))
[(quote ,d) (null? d)] [(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]))) [else #f])))
(define inline-lists (define inline-lists
(lambda (?p ?ls ?ls* lvl ctxt sc wd name moi) (lambda (?p ?ls ?ls* lvl map? ctxt sc wd name moi)
; (map proc (list a11 a12 ... a1m) (list a21 a22 ... a2m) ... (list an1 an2 ... anm)) => ; (map/for-each proc (list a11 a12 ... a1m) (list a21 a22 ... a2m) ... (list an1 an2 ... anm)) =>
; (let ([p proc]) ; (let ([p proc])
; (let ([t21 a21] [t22 a22] ... [t2m a2m]) ; (let ([t11 a11] ... [t1m a1m])
; ... ; ...
; (let ([tn1 an1] [tn2 an2] ... [tnm anm]) ; (let ([tn1 an1] ... [tnm anm])
; (list (p a11 t21 ... tn1) ; (list/begin (p t11 ... tn1)
; (p a12 t22 ... tn2) ; (p t12 ... tn2)
; ... ; ...
; (p a1m t2m ... tnm))))) ; (p t1m ... tnm)))))
(let loop ([ls* (cons ?ls ?ls*)] [e** '()]) (let loop ([ls* (cons ?ls ?ls*)] [e** '()] [all-quoted? #t])
(if (null? ls*) (if (null? ls*)
(and (apply = (map length e**)) (and (apply = (map length e**))
(let* ([e** (reverse e**)] [e* (car e**)] [e** (cdr e**)]) (or (not all-quoted?) (fx<= (length (car e**)) 4))
(let ([p (cp0-make-temp (fx> (length (car e**)) 1))]
[temp** (map (lambda (e*)
(map (lambda (x) (cp0-make-temp #f)) e*))
e**)])
(residualize-seq (list* ?p ?ls ?ls*) '() ctxt) (residualize-seq (list* ?p ?ls ?ls*) '() ctxt)
(let ([p (cp0-make-temp (fx> (length e*) 1))] (build-let (list p) (list (value-visit-operand! ?p))
[temp** (map (lambda (e*) (let f ([t** temp**] [e** (reverse e**)] [ls* (cons ?ls ?ls*)])
(map (lambda (x) (cp0-make-temp #f)) e*)) (if (null? t**)
e**)]) (let ([results
(build-let (list p) (list (value-visit-operand! ?p)) (let ([preinfo (app-preinfo ctxt)])
(let f ([t** temp**] [e** e**] [ls* ?ls*]) (let g ([t** temp**])
(if (null? t**) (if (null? (car t**))
(non-result-exp (value-visit-operand! ?ls) '()
(build-primcall lvl 'list (cons `(call ,preinfo (ref #f ,p)
(let ([preinfo (app-preinfo ctxt)]) ,(map (lambda (t*) (build-ref (car t*))) t**) ...)
(let g ([e* e*] [t** temp**]) (g (map cdr t**))))))])
(if (null? e*) (if map?
'() (build-primcall lvl 'list results)
(cons `(call ,preinfo (ref #f ,p) ,(car e*) (make-seq* ctxt results)))
,(map (lambda (t*) (build-ref (car t*))) t**) ...) (non-result-exp (value-visit-operand! (car ls*))
(g (cdr e*) (map cdr t**)))))))) (build-let (car t**) (car e**)
(non-result-exp (value-visit-operand! (car ls*)) (f (cdr t**) (cdr e**) (cdr 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*))) (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* ...) [(call ,preinfo ,e ,e* ...)
(and (primref? e) (eq? (primref-name e) 'list) (loop (cdr ls*) (cons e* e**)))] (and (primref? e) (eq? (primref-name e) 'list) (loop (cdr ls*) (cons e* e**) #f))]
[else #f]))))) [else #f])))))
(define-inline 2 map (define-inline 2 map
[(?p ?ls . ?ls*) [(?p ?ls . ?ls*)
@ -3611,14 +3619,13 @@
(begin (begin
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt) (residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
null-rec) null-rec)
(inline-lists ?p ?ls ?ls* 2 ctxt sc wd name moi))]) (inline-lists ?p ?ls ?ls* 2 #t ctxt sc wd name moi))])
(define-inline 3 map (define-inline 3 map
[(?p ?ls . ?ls*) [(?p ?ls . ?ls*)
(cond (cond
[(ormap null-rec? (cons ?ls ?ls*)) [(ormap null-rec? (cons ?ls ?ls*))
(begin (residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
(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) ; 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 ; map is guaranteed (even at optimization level 3) not to get sick if an
; input list is mutated, while for-each is not. ; input list is mutated, while for-each is not.
@ -3628,15 +3635,18 @@
(and (if (all-set? (prim-mask unsafe) flags) (and (if (all-set? (prim-mask unsafe) flags)
(all-set? (prim-mask discard) flags) (all-set? (prim-mask discard) flags)
(all-set? (prim-mask (or discard unrestricted)) flags)) (all-set? (prim-mask (or discard unrestricted)) flags))
(arity-okay? (primref-arity pr) (+ (length ?ls*) 1))))] (arity-okay? (primref-arity pr) (fx+ (length ?ls*) 1))))]
[else #f])) [else #f]))
; discard effect-free calls to map in effect context ; discard effect-free calls to map in effect context
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt) (residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec] void-rec]
[(inline-lists ?p ?ls ?ls* 3 #t ctxt sc wd name moi)]
[(ormap (lambda (?ls) [(ormap (lambda (?ls)
(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls)) (nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls))
[(quote ,d) [(quote ,d)
(and (list? d) (let ([n (length d)]) (and (fx<= n 4) n)))] (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])) [else #f]))
(cons ?ls ?ls*)) => (cons ?ls ?ls*)) =>
(lambda (n) (lambda (n)
@ -3681,7 +3691,7 @@
ls*) ...) ls*) ...)
ropnd*)))))))) ropnd*))))))))
ctxt empty-env sc wd name moi))] ctxt empty-env sc wd name moi))]
[else (inline-lists ?p ?ls ?ls* 3 ctxt sc wd name moi)])]) [else #f])])
(define-inline 2 for-each (define-inline 2 for-each
[(?p ?ls . ?ls*) [(?p ?ls . ?ls*)
@ -3689,110 +3699,114 @@
[(andmap null-rec? (cons ?ls ?ls*)) [(andmap null-rec? (cons ?ls ?ls*))
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt) (residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec] void-rec]
[else #f])]) [else
) (inline-lists ?p ?ls ?ls* 2 #f ctxt sc wd name moi)])])
(define-inline 3 for-each (define-inline 3 for-each
[(?p ?ls . ?ls*) [(?p ?ls . ?ls*)
(cond (cond
[(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?p)) [(ormap null-rec? (cons ?ls ?ls*))
[,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) (+ (length ?ls*) 1))))]
[else #f])
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec]
[(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)))]
[else #f]))
(cons ?ls ?ls*)) =>
(lambda (n)
(cond
[(fx= n 0)
; (for-each proc e1 ... (begin e2 ... '()) e3 ...) => ; (for-each proc e1 ... (begin e2 ... '()) e3 ...) =>
; (begin e1 ... (begin e2 ... '()) e3 ... (void)) ; (begin e1 ... (begin e2 ... '()) e3 ... (void))
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt) (begin
void-rec] (residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
[else void-rec)]
; (for-each proc e1 ... (begin e2 ... '(a b c d)) e3 ...) [(nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?p))
; ((lambda (p ls ...) [,pr (let ([flags (primref-flags pr)])
; (proc (car ls) ...) (and (if (all-set? (prim-mask unsafe) flags)
; (let ([t1 (cdr ls)] ...) (all-set? (prim-mask discard) flags)
; (proc (car t1) ...) (all-set? (prim-mask (or discard unrestricted)) flags))
; (let ([t2 (cdr t1)] ...) (arity-okay? (primref-arity pr) (fx+ (length ?ls*) 1))))]
; (proc (car t2) ...) [else #f])
; (proc (cadr t2) ...)))) (residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
; proc e1 ... (begin e2 ... '(a b c d)) e3 ...) void-rec]
(cp0 [(inline-lists ?p ?ls ?ls* 3 #f ctxt sc wd name moi)]
(let ([p (cp0-make-temp (fx> n 1))] [(ormap (lambda (?ls)
[ls* (cons (cp0-make-temp #t) (nanopass-case (Lsrc Expr) (result-exp (value-visit-operand! ?ls))
(map (lambda (x) (cp0-make-temp #t)) ?ls*))]) [(quote ,d)
(build-lambda (cons p ls*) (and (list? d) (let ([n (length d)]) (and (fx<= n 4) n)))]
(cond [(call ,preinfo ,e ,e* ...)
[(fx= n 1) (and (primref? e) (eq? (primref-name e) 'list) (let ([n (length e*)]) (and (fx<= n 4) n)))]
`(call ,(app-preinfo ctxt) (ref #f ,p) [else #f]))
,(map (lambda (x) (cons ?ls ?ls*)) =>
(build-primcall 3 'car (list (build-ref x)))) (lambda (n)
ls*) ...)] (safe-assert (not (= n 0))) ; guaranteed before we get here
[else ; (for-each proc e1 ... (begin e2 ... '(a b c d)) e3 ...)
(let f ([n n] [ls* ls*]) ; ((lambda (p ls ...)
(if (fx= n 2) ; (proc (car ls) ...)
(make-seq 'value ; (let ([t1 (cdr ls)] ...)
`(call ,(app-preinfo ctxt) (ref #f ,p) ; (proc (car t1) ...)
,(map (lambda (x) ; (let ([t2 (cdr t1)] ...)
(build-primcall 3 'car (list (build-ref x)))) ; (proc (car t2) ...)
ls*) ...) ; (proc (cadr t2) ...))))
`(call ,(app-preinfo ctxt) (ref #f ,p) ; proc e1 ... (begin e2 ... '(a b c d)) e3 ...)
,(map (lambda (x) (cp0
(build-primcall 3 'cadr (list (build-ref x)))) (let ([p (cp0-make-temp (fx> n 1))]
ls*) ...)) [ls* (cons (cp0-make-temp #t)
(make-seq 'value (map (lambda (x) (cp0-make-temp #t)) ?ls*))])
`(call ,(app-preinfo ctxt) (ref #f ,p) (build-lambda (cons p ls*)
,(map (lambda (x) (cond
(build-primcall 3 'car (list (build-ref x)))) [(fx= n 1)
ls*) ...) `(call ,(app-preinfo ctxt) (ref #f ,p)
(let ([tls* (map (lambda (x) (cp0-make-temp #t)) ls*)]) ,(map (lambda (x)
(build-let tls* (build-primcall 3 'car (list (build-ref x))))
(map (lambda (x) ls*) ...)]
(build-primcall 3 'cdr (list (build-ref x)))) [else
ls*) (let f ([n n] [ls* ls*])
(f (fx- n 1) tls*))))))]))) (if (fx= n 2)
ctxt empty-env sc wd name moi)]))] (make-seq 'value
[else `(call ,(app-preinfo ctxt) (ref #f ,p)
(and likely-to-be-compiled? ,(map (lambda (x)
(cp0 (build-primcall 3 'car (list (build-ref x))))
(let ([?ls* (cons ?ls ?ls*)]) ls*) ...)
(let ([p (cp0-make-temp #t)] `(call ,(app-preinfo ctxt) (ref #f ,p)
[r (cp0-make-temp #t)] ,(map (lambda (x)
[do (cp0-make-temp #t)] (build-primcall 3 'cadr (list (build-ref x))))
[tls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)] ls*) ...))
[ls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)]) (make-seq 'value
(build-lambda (cons p tls*) `(call ,(app-preinfo ctxt) (ref #f ,p)
`(if ,(build-primcall 3 'null? ,(map (lambda (x)
(list (build-ref (car tls*)))) (build-primcall 3 'car (list (build-ref x))))
,void-rec ls*) ...)
,(build-named-let do ls* (let ([tls* (map (lambda (x) (cp0-make-temp #t)) ls*)])
(map build-ref tls*) (build-let tls*
(build-let (list r) (map (lambda (x)
(list (build-primcall 3 'cdr (list (build-ref (car ls*))))) (build-primcall 3 'cdr (list (build-ref x))))
`(if ,(build-primcall 3 'null? (list (build-ref r))) ls*)
(call ,(app-preinfo ctxt) (ref #f ,p) (f (fx- n 1) tls*))))))])))
,(map (lambda (x) ctxt empty-env sc wd name moi))]
(build-primcall 3 'car (list (build-ref x)))) [else
ls*) ...) (and likely-to-be-compiled?
,(make-seq 'value (cp0
`(call ,(app-preinfo ctxt) (ref #f ,p) (let ([?ls* (cons ?ls ?ls*)])
,(map (lambda (x) (let ([p (cp0-make-temp #t)]
(build-primcall 3 'car (list (build-ref x)))) [r (cp0-make-temp #t)]
ls*) ...) [do (cp0-make-temp #t)]
`(call ,(make-preinfo) (ref #f ,do) (ref #f ,r) [tls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)]
,(map (lambda (x) [ls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)])
(build-primcall 3 'cdr (list (build-ref x)))) (build-lambda (cons p tls*)
(cdr ls*)) ...))))))))) `(if ,(build-primcall 3 'null?
ctxt empty-env sc wd name moi))])]) (list (build-ref (car tls*))))
,void-rec
,(build-named-let do ls*
(map build-ref tls*)
(build-let (list r)
(list (build-primcall 3 'cdr (list (build-ref (car ls*)))))
`(if ,(build-primcall 3 'null? (list (build-ref r)))
(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car (list (build-ref x))))
ls*) ...)
,(make-seq 'value
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car (list (build-ref x))))
ls*) ...)
`(call ,(make-preinfo) (ref #f ,do) (ref #f ,r)
,(map (lambda (x)
(build-primcall 3 'cdr (list (build-ref x))))
(cdr ls*)) ...)))))))))
ctxt empty-env sc wd name moi))])])
)
(define-inline 3 vector-map (define-inline 3 vector-map
[(?p ?v . ?v*) [(?p ?v . ?v*)