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.
cp0.ss,
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 '(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
@ -1924,6 +1948,46 @@
'(#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

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-t-f 2017-05-29 02:30:33.000000000 -0400
*** errors-compile-0-f-f-f 2017-06-08 02:10:03.000000000 -0400
--- errors-compile-0-f-t-f 2017-06-08 01:38:37.000000000 -0400
***************
*** 125,131 ****
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: "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 ****
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".

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-t-f-f 2017-05-29 02:38:26.000000000 -0400
*** errors-compile-0-f-f-f 2017-06-08 02:10:03.000000000 -0400
--- errors-compile-0-t-f-f 2017-06-08 01:45:53.000000000 -0400
***************
*** 93,99 ****
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-interpret-0-f-f-f 2017-05-29 02:47:10.000000000 -0400
*** errors-compile-0-f-f-f 2017-06-08 02:10:03.000000000 -0400
--- errors-interpret-0-f-f-f 2017-06-08 01:53:14.000000000 -0400
***************
*** 1,7 ****
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-interpret-0-f-t-f 2017-05-29 02:54:57.000000000 -0400
*** errors-compile-0-f-t-f 2017-06-08 01:38:37.000000000 -0400
--- errors-interpret-0-f-t-f 2017-06-08 02:00:50.000000000 -0400
***************
*** 1,7 ****
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-interpret-3-f-f-f 2017-05-29 03:10:12.000000000 -0400
*** errors-compile-3-f-f-f 2017-06-08 01:35:00.000000000 -0400
--- errors-interpret-3-f-f-f 2017-06-08 02:15:41.000000000 -0400
***************
*** 1,3 ****
--- 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-interpret-3-f-t-f 2017-05-29 02:58:45.000000000 -0400
*** errors-compile-3-f-t-f 2017-06-08 01:42:09.000000000 -0400
--- errors-interpret-3-f-t-f 2017-06-08 02:04:33.000000000 -0400
***************
*** 1,3 ****
--- 1,9 ----

292
s/cp0.ss
View File

@ -3565,45 +3565,53 @@
(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 ctxt sc wd name moi)
; (map proc (list a11 a12 ... a1m) (list a21 a22 ... a2m) ... (list an1 an2 ... anm)) =>
(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)) =>
; (let ([p proc])
; (let ([t21 a21] [t22 a22] ... [t2m a2m])
; (let ([t11 a11] ... [t1m a1m])
; ...
; (let ([tn1 an1] [tn2 an2] ... [tnm anm])
; (list (p a11 t21 ... tn1)
; (p a12 t22 ... tn2)
; ...
; (p a1m t2m ... tnm)))))
(let loop ([ls* (cons ?ls ?ls*)] [e** '()])
; (let ([tn1 an1] ... [tnm anm])
; (list/begin (p t11 ... tn1)
; (p t12 ... tn2)
; ...
; (p t1m ... tnm)))))
(let loop ([ls* (cons ?ls ?ls*)] [e** '()] [all-quoted? #t])
(if (null? ls*)
(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)
(let ([p (cp0-make-temp (fx> (length e*) 1))]
[temp** (map (lambda (e*)
(map (lambda (x) (cp0-make-temp #f)) e*))
e**)])
(build-let (list p) (list (value-visit-operand! ?p))
(let f ([t** temp**] [e** e**] [ls* ?ls*])
(if (null? t**)
(non-result-exp (value-visit-operand! ?ls)
(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**))))))))
(non-result-exp (value-visit-operand! (car ls*))
(build-let (car t**) (car e**)
(f (cdr t**) (cdr e**) (cdr ls*))))))))))
(build-let (list p) (list (value-visit-operand! ?p))
(let f ([t** temp**] [e** (reverse e**)] [ls* (cons ?ls ?ls*)])
(if (null? t**)
(let ([results
(let ([preinfo (app-preinfo ctxt)])
(let g ([t** temp**])
(if (null? (car t**))
'()
(cons `(call ,preinfo (ref #f ,p)
,(map (lambda (t*) (build-ref (car t*))) t**) ...)
(g (map cdr t**))))))])
(if map?
(build-primcall lvl 'list results)
(make-seq* ctxt results)))
(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**)))]
(and (primref? e) (eq? (primref-name e) 'list) (loop (cdr ls*) (cons e* e**) #f))]
[else #f])))))
(define-inline 2 map
[(?p ?ls . ?ls*)
@ -3611,14 +3619,13 @@
(begin
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
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
[(?p ?ls . ?ls*)
(cond
[(ormap null-rec? (cons ?ls ?ls*))
(begin
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
null-rec)]
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
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.
@ -3628,15 +3635,18 @@
(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))))]
(arity-okay? (primref-arity pr) (fx+ (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)))]
(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)
@ -3681,7 +3691,7 @@
ls*) ...)
ropnd*))))))))
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
[(?p ?ls . ?ls*)
@ -3689,110 +3699,114 @@
[(andmap null-rec? (cons ?ls ?ls*))
(residualize-seq '() (list* ?p ?ls ?ls*) ctxt)
void-rec]
[else #f])])
)
(define-inline 3 for-each
[(?p ?ls . ?ls*)
(cond
[(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) (+ (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)
[else
(inline-lists ?p ?ls ?ls* 2 #f ctxt sc wd name moi)])])
(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))
(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) ...)
; (let ([t1 (cdr ls)] ...)
; (proc (car t1) ...)
; (let ([t2 (cdr t1)] ...)
; (proc (car t2) ...)
; (proc (cadr t2) ...))))
; proc e1 ... (begin e2 ... '(a b c d)) e3 ...)
(cp0
(let ([p (cp0-make-temp (fx> n 1))]
[ls* (cons (cp0-make-temp #t)
(map (lambda (x) (cp0-make-temp #t)) ?ls*))])
(build-lambda (cons p ls*)
(cond
[(fx= n 1)
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car (list (build-ref x))))
ls*) ...)]
[else
(let f ([n n] [ls* ls*])
(if (fx= n 2)
(make-seq 'value
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car (list (build-ref x))))
ls*) ...)
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'cadr (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*) ...)
(let ([tls* (map (lambda (x) (cp0-make-temp #t)) ls*)])
(build-let tls*
(map (lambda (x)
(build-primcall 3 'cdr (list (build-ref x))))
ls*)
(f (fx- n 1) tls*))))))])))
ctxt empty-env sc wd name moi)]))]
[else
(and likely-to-be-compiled?
(cp0
(let ([?ls* (cons ?ls ?ls*)])
(let ([p (cp0-make-temp #t)]
[r (cp0-make-temp #t)]
[do (cp0-make-temp #t)]
[tls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)]
[ls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)])
(build-lambda (cons p tls*)
`(if ,(build-primcall 3 'null?
(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))])])
(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))))]
[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
; (for-each proc e1 ... (begin e2 ... '(a b c d)) e3 ...)
; ((lambda (p ls ...)
; (proc (car ls) ...)
; (let ([t1 (cdr ls)] ...)
; (proc (car t1) ...)
; (let ([t2 (cdr t1)] ...)
; (proc (car t2) ...)
; (proc (cadr t2) ...))))
; proc e1 ... (begin e2 ... '(a b c d)) e3 ...)
(cp0
(let ([p (cp0-make-temp (fx> n 1))]
[ls* (cons (cp0-make-temp #t)
(map (lambda (x) (cp0-make-temp #t)) ?ls*))])
(build-lambda (cons p ls*)
(cond
[(fx= n 1)
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car (list (build-ref x))))
ls*) ...)]
[else
(let f ([n n] [ls* ls*])
(if (fx= n 2)
(make-seq 'value
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'car (list (build-ref x))))
ls*) ...)
`(call ,(app-preinfo ctxt) (ref #f ,p)
,(map (lambda (x)
(build-primcall 3 'cadr (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*) ...)
(let ([tls* (map (lambda (x) (cp0-make-temp #t)) ls*)])
(build-let tls*
(map (lambda (x)
(build-primcall 3 'cdr (list (build-ref x))))
ls*)
(f (fx- n 1) tls*))))))])))
ctxt empty-env sc wd name moi))]
[else
(and likely-to-be-compiled?
(cp0
(let ([?ls* (cons ?ls ?ls*)])
(let ([p (cp0-make-temp #t)]
[r (cp0-make-temp #t)]
[do (cp0-make-temp #t)]
[tls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)]
[ls* (map (lambda (x) (cp0-make-temp #t)) ?ls*)])
(build-lambda (cons p tls*)
`(if ,(build-primcall 3 'null?
(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
[(?p ?v . ?v*)