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

Kazmir ain't looking too sharp tonight. How interesting. And I thought

Browse Source 
tonight might have been rough on the other side of things.

svn: r11771
This commit is contained in:
Stevie Strickland 2008-09-16 00:28:55 +00:00
commit d184da32ec
3 changed files with 13 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/s-exp/lang/reader.ss
View File

@ -5,4 +5,4 @@
(let* ([mod* (rd in)]
[mod (if stx? (syntax->list mod*) mod*)]
[mod `(,(car mod) ,(cadr mod) ,@(cdddr mod))])
(if stx? (datum->syntax mod* mod) mod))))
(if stx? (datum->syntax mod* mod mod*) mod))))

8
collects/syntax/module-reader.ss
View File

@ -74,6 +74,12 @@
[body (cond [(not wrapper) (body)]
[(procedure-arity-includes? wrapper 2) (wrapper body stx?)]
[else (wrapper body)])]
[all-loc (vector src line col pos
(let-values ([(l c p) (port-next-location port)])
(and p (- p pos))))]
[body (if (and stx? (not (syntax? body)))
(datum->syntax #f body all-loc)
body)]
[p-name (object-name port)]
[name (if (path? p-name)
(let-values ([(base name dir?) (split-path p-name)])
@ -89,7 +95,7 @@
v))]
[lib (if stx? (datum->syntax #f lib modpath modpath) lib)]
[r `(,(tag-src 'module) ,(tag-src name) ,lib . ,body)])
(if stx? (datum->syntax #f r) r)))
(if stx? (datum->syntax #f r all-loc) r)))
(define (wrap lib port read modpath src line col pos)
(wrap-internal lib port read #f #f #f modpath src line col pos))

15
collects/typed-scheme/no-check/lang/reader.ss
View File

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