diff --git a/collects/tests/typed-scheme/succeed/apply-dots.ss b/collects/tests/typed-scheme/succeed/apply-dots.ss index 506f11a7..4d13e0d9 100644 --- a/collects/tests/typed-scheme/succeed/apply-dots.ss +++ b/collects/tests/typed-scheme/succeed/apply-dots.ss @@ -16,4 +16,50 @@ (apply (case-lambda: (([x : Number] . [y : Number ... a]) x) (([x : String] [y : String] . [z : String]) 0) ([y : Number] 0)) - w)) \ No newline at end of file + w)) + +;; */*/poly +(plambda: (a ...) ([z : String] . [w : Number]) + (apply (plambda: (b) ([x : b] . [y : Number]) x) + 1 w)) + +(plambda: (a ...) ([z : String] . [w : Number]) + (apply (plambda: (b) ([x : b] . [y : Number]) x) + 1 2 3 w)) + +;; */*/polydots +(plambda: (a ...) ([z : String] . [w : Number]) + (apply (plambda: (b ...) ([x : Number] . [y : Number]) x) + 1 w)) + +(plambda: (a ...) ([z : String] . [w : Number]) + (apply (plambda: (b ...) ([x : Number] . [y : Number]) x) + 1 1 1 w)) + +;; */.../poly +(plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b) ([x : Number] . [y : Number]) x) + 1 w)) + +(plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b) ([x : Number] . [y : Number]) x) + 1 1 1 1 w)) + +;; */.../polydots +#;(plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b ...) ([x : Number] . [y : Number]) x) + 1 w)) + +#;(plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b ...) ([x : Number] . [y : Number]) x) + 1 1 1 1 w)) + +;; .../.../poly +(plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b) ([x : Number] . [y : Number ... a]) x) + 1 w)) + +#;(plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b ...) ([x : Number] . [y : Number ... a]) x) + 1 w)) + diff --git a/collects/tests/typed-scheme/succeed/cl-bug.ss b/collects/tests/typed-scheme/succeed/cl-bug.ss new file mode 100644 index 00000000..6b5a61c6 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/cl-bug.ss @@ -0,0 +1,15 @@ +#lang typed-scheme + +(: f (case-lambda (Integer * -> Integer) (Number * -> Number))) +(define (f . x) (+ 1 2)) + +(: f4 (case-lambda (Integer * -> Integer) (Number * -> Number))) +(define (f4 . x) (apply + x)) + +(: f3 (case-lambda (Integer * -> Integer) (Number * -> Number))) +(define (f3 x y) (+ x y)) + +(+ 1 'foo) + +(: f2 (case-lambda (Number * -> Number))) +(define (f2 x y) (+ x y)) \ No newline at end of file diff --git a/collects/tests/typed-scheme/succeed/fold-left.ss b/collects/tests/typed-scheme/succeed/fold-left.ss new file mode 100644 index 00000000..5b8c6e73 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/fold-left.ss @@ -0,0 +1,19 @@ +#lang typed-scheme + +(: fold-left (All (c a b ...) ((c a b ... b -> c) c (Listof a) (Listof b) ... b -> c))) +(define (fold-left f c as . bss) + (if (or (null? a) + (ormap null? bss)) + c + (apply fold-left f + (apply f c (car as) (map car bss)) + (cdr as) (map cdr bs)))) + +(: fold-right (All (c a b ...) ((c a b ... b -> c) c (Listof a) (Listof b) ... b -> c))) +(define (fold-right f c as . bss) + (if (or (null? a) + (ormap null? bss)) + c + (apply f + (apply fold-left f c (cdr as) (map cdr bs)) + (car as) (map car bss)))) \ No newline at end of file diff --git a/collects/tests/typed-scheme/succeed/lots-o-bugs.ss b/collects/tests/typed-scheme/succeed/lots-o-bugs.ss new file mode 100644 index 00000000..21e5dd9c --- /dev/null +++ b/collects/tests/typed-scheme/succeed/lots-o-bugs.ss @@ -0,0 +1,23 @@ +#lang typed-scheme + +;; (All (a ...) ( -> (a ... a -> Integer))) +#; +(plambda: (a ...) () + (lambda: [ys : a ... a] 3)) + +(define x (plambda: (a ...) () (lambda: [ys : a ... a] 3))) + + +#;#; +(: y (All (a ...) ( -> (a ... a -> Integer)))) +(define y (plambda: (a ...) () (lambda: [ys : a ... a] 3))) +#;#; +(: z (All (a ...) ( -> (a ... a -> Integer)))) +(define z (lambda () (lambda ys 3))) + +#; +((plambda: (a ...) () (lambda: [ys : a ... a] 3))) + +#; +((plambda: (a ...) [xs : a ... a] (lambda: [ys : a ... a] 3)) + 1 2 3) \ No newline at end of file diff --git a/collects/tests/typed-scheme/succeed/unholy-terror.ss b/collects/tests/typed-scheme/succeed/unholy-terror.ss new file mode 100644 index 00000000..4802241a --- /dev/null +++ b/collects/tests/typed-scheme/succeed/unholy-terror.ss @@ -0,0 +1,30 @@ +#lang typed-scheme + +(apply (plambda: (a ...) [ys : (a ... a -> Number) *] + (lambda: [zs : a ... a] + (map (lambda: ([y : (a ... a -> Number)]) + (apply y zs)) + ys))) + (list (lambda: ([x : Number] [y : Number]) (+ x y)) + (lambda: ([x : Number] [y : Number]) (- x y)) + (lambda: ([x : Number] [y : Number]) (* x y)) + (lambda: ([x : Number] [y : Number]) (/ x y)))) + +((apply (plambda: (a ...) [ys : (a ... a -> Number) *] + (lambda: [zs : a ... a] + (map (lambda: ([y : (a ... a -> Number)]) + (apply y zs)) + ys))) + (list (lambda: ([x : Number] [y : Number]) (+ x y)) + (lambda: ([x : Number] [y : Number]) (- x y)) + (lambda: ([x : Number] [y : Number]) (* x y)) + (lambda: ([x : Number] [y : Number]) (/ x y)))) + 3 4) + + +(apply (plambda: (a ...) [ys : (a ... a -> Number) *] + (lambda: [zs : a ... a] + (map (lambda: ([y : (a ... a -> Number)]) + (apply y zs)) + ys))) + (list + - * /)) \ No newline at end of file diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss index 11047522..80afadc0 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss @@ -551,6 +551,18 @@ [tc-e (plambda: (b ...) [y : (Listof Integer) ... b] (apply append y)) (-polydots (b) (->... (list) ((-lst -Integer) b) (-lst -Integer)))] + [tc-err (plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b) ([x : Number] . [y : Number ... a]) x) + 1 1 1 1 w))] + + [tc-err (plambda: (a ...) ([z : String] . [w : Number]) + (apply (plambda: (b) ([x : Number] . [y : Number ... a]) x) + 1 w))] + + [tc-err (plambda: (a ...) ([z : String] . [w : Number ... a]) + (apply (plambda: (b ...) ([x : Number] . [y : Number ... b]) x) + 1 w))] + ;; error tests [tc-err (#%variable-reference number?)] [tc-err (+ 3 #f)]