From af7b966c82cf3ed41ec4a3acf37e5503033ce912 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 27 Apr 2009 21:58:35 +0000 Subject: [PATCH] more contracts more fixes svn: r14632 --- collects/typed-scheme/env/type-environments.ss | 5 +++-- collects/typed-scheme/typecheck/tc-envops.ss | 2 +- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/collects/typed-scheme/env/type-environments.ss b/collects/typed-scheme/env/type-environments.ss index b62d7d024a..3a0b5679a1 100644 --- a/collects/typed-scheme/env/type-environments.ss +++ b/collects/typed-scheme/env/type-environments.ss @@ -20,7 +20,7 @@ with-dotted-env/extend) ;; eq? has the type of equal?, and l is an alist (with conses!) -(define-struct env (eq? l)) +(r:d-s/c env ([eq? (any/c any/c . -> . boolean?)] [l (listof pair?)])) (define (env-vals e) (map cdr (env-l e))) @@ -45,7 +45,8 @@ ;; the environment for types of ... variables (define dotted-env (make-parameter (make-empty-env free-identifier=?))) -(define (env-map f env) +(define/contract (env-map f env) + ((pair? . -> . pair?) env? . -> . env?) (make-env (env-eq? env) (map f (env-l env)))) ;; extend that works on single arguments diff --git a/collects/typed-scheme/typecheck/tc-envops.ss b/collects/typed-scheme/typecheck/tc-envops.ss index a7fa27867a..292391ed00 100644 --- a/collects/typed-scheme/typecheck/tc-envops.ss +++ b/collects/typed-scheme/typecheck/tc-envops.ss @@ -50,6 +50,6 @@ (env? (listof Filter/c) . -> . env?) (for/fold ([Γ env]) ([f fs]) (match f - [(Bot:) (env-map (lambda (_) (Un)) Γ)] + [(Bot:) (env-map (lambda (x) (cons (car x) (Un))) Γ)] [(or (TypeFilter: _ _ x) (NotTypeFilter: _ _ x)) (update-type/lexical (lambda (x t) (update t f)) x Γ)])))