From 8be54e9a3b264d7b9a20d9fb80ea40ccdf0151f6 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 19 Jun 2008 14:59:19 -0400 Subject: [PATCH] Add unit test for dotted instantiation, and add version of fold-left/fold-right that explicitly instantiates the recursive call. original commit: 2a7dbe2a80d34abc5097e144b80bda9965546703 --- .../typed-scheme/succeed/fold-left-inst.ss | 19 +++++++++++++++++++ .../unit-tests/typecheck-tests.ss | 3 +++ 2 files changed, 22 insertions(+) create mode 100644 collects/tests/typed-scheme/succeed/fold-left-inst.ss diff --git a/collects/tests/typed-scheme/succeed/fold-left-inst.ss b/collects/tests/typed-scheme/succeed/fold-left-inst.ss new file mode 100644 index 00000000..100ecbba --- /dev/null +++ b/collects/tests/typed-scheme/succeed/fold-left-inst.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? as) + (ormap null? bss)) + c + (apply (inst fold-left c a b ... b) f + (apply f c (car as) (map car bss)) + (cdr as) (map cdr bss)))) + +(: 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? as) + (ormap null? bss)) + c + (apply f + (apply (inst fold-left c a b ... b) f c (cdr as) (map cdr bss)) + (car as) (map car bss)))) \ 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 ea2444a3..1f5b1d1f 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss @@ -577,6 +577,9 @@ (-Integer B -Integer . -> . -Integer) . -> . -Integer)] + [tc-e (plambda: (z x y ...) () (inst map z x y ... y)) + (-polydots (z x y) ((list ((list z x) (y y) . ->... . z) z (-lst x)) ((-lst y) y) . ->... . (-lst z)))] + ;; error tests [tc-err (#%variable-reference number?)] [tc-err (+ 3 #f)]