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

Fix typed scheme reader for new reader API.

Browse Source 
svn: r9182

original commit: b800f4ed3e3c66cb879bb2b26258ea3cda23cf56
This commit is contained in:
Sam Tobin-Hochstadt 2008-04-07 21:03:27 +00:00
commit a015829d77
3 changed files with 10 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/typed-scheme/lang/reader.ss
View File

@ -2,13 +2,12 @@
(require (prefix-in r: "../typed-reader.ss")
(only-in syntax/module-reader wrap-read-all))
(define (*read in)
(wrap-read-all 'typed-scheme in r:read))
(define (*read in modpath line col pos)
(wrap-read-all 'typed-scheme in r:read modpath #f line col pos))
(define (*read-syntax src in)
(wrap-read-all 'typed-scheme
in
(lambda (in)
(r:read-syntax src in))))
(define (*read-syntax src in modpath line col pos)
(wrap-read-all
'typed-scheme in (lambda (in) (r:read-syntax src in))
modpath src line col pos))
(provide (rename-out [*read read] [*read-syntax read-syntax]))

6
collects/typed-scheme/private/base-env.ss
View File

@ -7,7 +7,7 @@
string-constants/string-constant
#;'#%more-scheme
#;'#%qq-and-or
(lib "match-error.ss" "mzlib" "private" "match"))
(only-in scheme/match/patterns match:error))
)
@ -20,7 +20,7 @@
(only-in "type-effect-convenience.ss" [make-arr* make-arr])
"union.ss"
string-constants/string-constant
(lib "match-error.ss" "mzlib" "private" "match")
(only-in scheme/match/patterns match:error)
"tc-structs.ss")
(require (for-syntax
@ -32,7 +32,7 @@
(only-in "type-effect-convenience.ss" [make-arr* make-arr])
"union.ss"
string-constants/string-constant
(lib "match-error.ss" "mzlib" "private" "match")
(only-in scheme/match/patterns match:error)
"tc-structs.ss"))
(define-for-syntax (initialize-others)

2
collects/typed-scheme/private/subtype.ss
View File

@ -99,7 +99,7 @@
(match (list s t)
;; top for functions is above everything
[(list _ (top-arr:)) A0]
[(list (arr: s1 s2 #f thn-eff els-eff) (arr: t1 t2 #f (or '() thn-eff) (or '() els-eff)))
[(list (arr: s1 s2 #f thn-eff els-eff) (arr: t1 t2 #f thn-eff els-eff))
(let ([A1 (subtypes* A0 t1 s1)])
(subtype* A1 s2 t2))]
[(list (arr: s1 s2 s3 thn-eff els-eff) (arr: t1 t2 t3 thn-eff* els-eff*))