From 7237ad6046a636b4ce0f5f1354fc0ff9237e416c Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Fri, 22 May 2009 19:26:06 +0000 Subject: [PATCH] Fix construction of predicate type for `declare-refinement'. svn: r14933 --- collects/typed-scheme/typecheck/tc-toplevel.ss | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/collects/typed-scheme/typecheck/tc-toplevel.ss b/collects/typed-scheme/typecheck/tc-toplevel.ss index 555b7bb836..24f16702d7 100644 --- a/collects/typed-scheme/typecheck/tc-toplevel.ss +++ b/collects/typed-scheme/typecheck/tc-toplevel.ss @@ -44,11 +44,11 @@ ;; FIXME - this sucks and should die [(define-values () (begin (quote-syntax (declare-refinement-internal pred)) (#%plain-app values))) (match (lookup-type/lexical #'pred) - [(and t (Function: (list (arr: (list dom) rng #f #f '())))) - (register-type #'pred - (make-pred-ty (list dom) - rng - (make-Refinement dom #'pred (syntax-local-certifier)))) + [(and t (Function: (list (arr: (list dom) (Values: (list (Result: rng _ _))) #f #f '())))) + (let ([new-t (make-pred-ty (list dom) + rng + (make-Refinement dom #'pred (syntax-local-certifier)))]) + (register-type #'pred new-t)) (list)] [t (tc-error "cannot declare refinement for non-predicate ~a" t)])]