suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

more contracts

Browse Source 
more fixes

svn: r14632
This commit is contained in:
Sam Tobin-Hochstadt 2009-04-27 21:58:35 +00:00
parent 9853ae1f0f
commit af7b966c82
2 changed files with 4 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/typed-scheme/env/type-environments.ss vendored
View File

@ -20,7 +20,7 @@
with-dotted-env/extend) with-dotted-env/extend)
;; eq? has the type of equal?, and l is an alist (with conses!) ;; 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) (define (env-vals e)
(map cdr (env-l e))) (map cdr (env-l e)))
@ -45,7 +45,8 @@
;; the environment for types of ... variables ;; the environment for types of ... variables
(define dotted-env (make-parameter (make-empty-env free-identifier=?))) (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)))) (make-env (env-eq? env) (map f (env-l env))))
;; extend that works on single arguments ;; extend that works on single arguments

2
collects/typed-scheme/typecheck/tc-envops.ss
View File

@ -50,6 +50,6 @@
(env? (listof Filter/c) . -> . env?) (env? (listof Filter/c) . -> . env?)
(for/fold ([Γ env]) ([f fs]) (for/fold ([Γ env]) ([f fs])
(match f (match f
[(Bot:) (env-map (lambda (_) (Un)) Γ)] [(Bot:) (env-map (lambda (x) (cons (car x) (Un))) Γ)]
[(or (TypeFilter: _ _ x) (NotTypeFilter: _ _ x)) [(or (TypeFilter: _ _ x) (NotTypeFilter: _ _ x))
(update-type/lexical (lambda (x t) (update t f)) x Γ)]))) (update-type/lexical (lambda (x t) (update t f)) x Γ)])))