From d0939ffa1e57894a076bfd6326c4d977cfdf3e2e Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 7 Jul 2008 14:49:46 -0400 Subject: [PATCH] Fix up singleton values --- collects/typed-scheme/private/infer-unit.ss | 4 ++-- collects/typed-scheme/private/type-utils.ss | 8 +++++++- 2 files changed, 9 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/private/infer-unit.ss b/collects/typed-scheme/private/infer-unit.ss index 450cd7312b..aad0be2482 100644 --- a/collects/typed-scheme/private/infer-unit.ss +++ b/collects/typed-scheme/private/infer-unit.ss @@ -464,7 +464,7 @@ ;; and T-dotted is the repeated type (define (infer/dots X dotted-var S T T-dotted R must-vars [expected #f]) (with-handlers ([exn:infer? (lambda _ #f)]) - (let* ([short-S (debug (take S (length T)))] + (let* ([short-S (take S (length T))] [rest-S (drop S (length T))] [cs-short (cgen/list null (cons dotted-var X) short-S T)] [new-vars (for/list ([i (in-range (length rest-S))]) (gensym dotted-var))] @@ -484,4 +484,4 @@ (define (i s t r) (infer/simple (list s) (list t) r)) -(trace cgen/arr cgen cgen/list) \ No newline at end of file +;;(trace cgen/arr cgen cgen/list) \ No newline at end of file diff --git a/collects/typed-scheme/private/type-utils.ss b/collects/typed-scheme/private/type-utils.ss index 80d7a5ffd6..f17a76260c 100644 --- a/collects/typed-scheme/private/type-utils.ss +++ b/collects/typed-scheme/private/type-utils.ss @@ -56,6 +56,12 @@ (make-ValuesDots (map sb types) (sb dty) dbound))]) target)) +;; the other definition is not accessible here +(define (-values args) + (if (= (length args) 1) + (car args) + (make-Values args))) + ;; substitute-dots : Listof[Type] Option[type] Name Type -> Type (define (substitute-dots images rimage name target) (define (sb t) (substitute-dots images rimage name t)) @@ -63,7 +69,7 @@ (type-case sb target [#:ValuesDots types dty dbound (if (eq? name dbound) - (make-Values + (-values (append (map sb types) ;; We need to recur first, just to expand out any dotted usages of this.