diff --git a/LOG b/LOG index 8f01a213c5..f361b3eb9b 100644 --- a/LOG +++ b/LOG @@ -879,3 +879,7 @@ $verify-ftype-address if the address expression is a call to ftype-pointer-address. ftype.ss +- Remove special case for (#2%map p '()) in cp0 + so the reduced version checks that p is a procedure. + Also make the same change for #2%for-each. + cp0.ss, 4.ms diff --git a/mats/4.ms b/mats/4.ms index cda433d6d8..3d531e227f 100644 --- a/mats/4.ms +++ b/mats/4.ms @@ -1079,6 +1079,10 @@ ((1 f k p u a) (2 g l q v b) (3 h m r w c) (4 i n s x d) (5 j o t y e)))) ; make sure compiler doesn't bomb w/two few args (procedure? (lambda (x) (map x))) + (error? ; nonprocedure + (map 3 '())) + (error? ; nonprocedure + (map 3 '() '())) (error? ; nonprocedure (map 3 '(a b c))) (error? ; nonprocedure @@ -1420,6 +1424,10 @@ 21) (procedure? (lambda (x) (fold-left x))) (procedure? (lambda (x) (fold-left x y))) + (error? ; nonprocedure + (fold-left 3 0 '())) + (error? ; nonprocedure + (fold-left 3 0 '() '())) (error? ; nonprocedure (fold-left 3 0 '(a b c))) (error? ; improper list @@ -1544,6 +1552,10 @@ ; make sure compiler doesn't bomb w/two few args (procedure? (lambda (x) (fold-right x))) (procedure? (lambda (x) (fold-right x y))) + (error? ; nonprocedure + (fold-right 3 0 '())) + (error? ; nonprocedure + (fold-right 3 0 '() '())) (error? ; nonprocedure (fold-right 3 0 '(a b c))) (error? ; improper list @@ -1722,11 +1734,24 @@ ; make sure compiler doesn't bomb w/two few args (procedure? (lambda (x) (for-each x))) + (error? ; nonprocedure + (for-each 3 '())) + (error? ; nonprocedure + (for-each 3 '() '())) (error? ; nonprocedure (for-each 3 '(a b c))) (error? ; nonprocedure (parameterize ([optimize-level 3]) (eval '(#2%for-each 3 '(a b c))))) + (error? ; nonprocedure + (parameterize ([optimize-level 3]) + (eval + '(let () + (define (f p b) + (unbox b) + (#2%for-each p (if (box? b) '() '(1 2 3))) + (list p (procedure? p))) + (f 7 (box 0)))))) (error? ; improper list (for-each pretty-print 'a)) (error? ; improper list @@ -2232,6 +2257,10 @@ (not (ormap (lambda (x y z) #t) '() '() '())) ; make sure compiler doesn't bomb w/two few args (procedure? (lambda (x) (ormap x))) + (error? ; nonprocedure + (ormap 3 '())) + (error? ; nonprocedure + (ormap 3 '() '())) (error? ; nonprocedure (ormap 3 '(a b c))) (error? ; improper list @@ -2333,6 +2362,10 @@ (eq? (andmap (lambda (x y z) #t) '() '() '()) #t) ; make sure compiler doesn't bomb w/two few args (procedure? (lambda (x) (andmap x))) + (error? ; nonprocedure + (andmap 3 '())) + (error? ; nonprocedure + (andmap 3 '() '())) (error? ; nonprocedure (andmap 3 '(a b c))) (error? ; improper list @@ -2434,6 +2467,10 @@ (not (exists (lambda (x y z) #t) '() '() '())) ; make sure compiler doesn't bomb w/two few args (procedure? (lambda (x) (exists x))) + (error? ; nonprocedure + (exists 3 '())) + (error? ; nonprocedure + (exists 3 '() '())) (error? ; nonprocedure (exists 3 '(a b c))) (error? ; improper list @@ -2535,6 +2572,10 @@ (eq? (for-all (lambda (x y z) #t) '() '() '()) #t) ; make sure compiler doesn't bomb w/two few args (procedure? (lambda (x) (for-all x))) + (error? ; nonprocedure + (for-all 3 '())) + (error? ; nonprocedure + (for-all 3 '() '())) (error? ; nonprocedure (for-all 3 '(a b c))) (error? ; improper list diff --git a/mats/root-experr-compile-0-f-f-f b/mats/root-experr-compile-0-f-f-f index d39d411c69..472415f8e6 100644 --- a/mats/root-experr-compile-0-f-f-f +++ b/mats/root-experr-compile-0-f-f-f @@ -269,6 +269,8 @@ primvars.mo:Expected error in mat trace-output-port: "trace-output-port: #