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

Fix construction of predicate type for `declare-refinement'.

Browse Source 
svn: r14933
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-22 19:26:06 +00:00
parent 7e6c1be6b0
commit 7237ad6046
1 changed files with 5 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/typed-scheme/typecheck/tc-toplevel.ss
View File

@ -44,11 +44,11 @@
;; FIXME - this sucks and should die ;; FIXME - this sucks and should die
[(define-values () (begin (quote-syntax (declare-refinement-internal pred)) (#%plain-app values))) [(define-values () (begin (quote-syntax (declare-refinement-internal pred)) (#%plain-app values)))
(match (lookup-type/lexical #'pred) (match (lookup-type/lexical #'pred)
[(and t (Function: (list (arr: (list dom) rng #f #f '())))) [(and t (Function: (list (arr: (list dom) (Values: (list (Result: rng _ _))) #f #f '()))))
(register-type #'pred (let ([new-t (make-pred-ty (list dom)
(make-pred-ty (list dom) rng
rng (make-Refinement dom #'pred (syntax-local-certifier)))])
(make-Refinement dom #'pred (syntax-local-certifier)))) (register-type #'pred new-t))
(list)] (list)]
[t (tc-error "cannot declare refinement for non-predicate ~a" t)])] [t (tc-error "cannot declare refinement for non-predicate ~a" t)])]