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

Add eof and read-accept-reader.

Browse Source 
Fix find-mutated-vars
This commit is contained in:
Sam Tobin-Hochstadt 2008-09-11 09:01:49 -04:00
parent c7b51cfd2d
commit 7cf9b36c15
3 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -560,7 +560,8 @@
[values (-polydots (a) (null (a a) . ->... . (make-ValuesDots null a 'a)))]
[call-with-values (-polydots (b a) ((-> (make-ValuesDots null a 'a)) (null (a a) . ->... . b) . -> . b))]
[foo (N #:bar B #f . ->key . B)]
[eof (-val eof)]
[read-accept-reader (-Param B B)]
)
(begin-for-syntax

13
collects/typed-scheme/private/mutated-vars.ss
View File

@ -14,12 +14,11 @@
;; syntax -> void
(define (fmv/list lstx)
(for-each find-mutated-vars (syntax->list lstx)))
;(printf "called with ~a~n" (syntax->datum form))
;(when (and (pair? (syntax->datum form))) (printf "called with ~a~n" (syntax->datum form)))
(kernel-syntax-case* form #f (define-type-alias-internal define-typed-struct-internal require/typed-internal)
;; what we care about: set!
[(set! v e)
(begin
;(printf "mutated var found: ~a~n" (syntax-e #'v))
(module-identifier-mapping-put! table #'v #t))]
[(define-values (var ...) expr)
(find-mutated-vars #'expr)]
@ -28,15 +27,13 @@
[(begin0 . rest) (fmv/list #'rest)]
[(#%plain-lambda _ . rest) (fmv/list #'rest)]
[(case-lambda (_ . rest) ...) (for-each fmv/list (syntax->list #'(rest ...)))]
[(if e1 e2) (begin (find-mutated-vars #'e1) (find-mutated-vars #'e2))]
[(if e1 e2 e3) (begin (find-mutated-vars #'e1) (find-mutated-vars #'e1) (find-mutated-vars #'e3))]
[(with-continuation-mark e1 e2 e3) (begin (find-mutated-vars #'e1)
(find-mutated-vars #'e1)
(find-mutated-vars #'e3))]
[(if . es) (fmv/list #'es)]
[(with-continuation-mark . es) (fmv/list #'es)]
[(let-values ([_ e] ...) . b) (begin (fmv/list #'(e ...))
(fmv/list #'b))]
[(letrec-values ([_ e] ...) . b) (begin (fmv/list #'(e ...))
(fmv/list #'b))]
(fmv/list #'b))]
[(#%expression e) (find-mutated-vars #'e)]
;; all the other forms don't have any expression subforms (like #%top)
[_ (void)]))

22
collects/typed-scheme/utils/utils.ss
View File

@ -30,16 +30,18 @@
(syntax-case stx ()
[(_ id ...)
(andmap identifier? (syntax->list #'(id ...)))
(with-syntax ([(id* ...) (map (lambda (id) (datum->syntax
id
(string->symbol
(string-append
"typed-scheme/"
#,(symbol->string (syntax-e #'nm))
"/"
(symbol->string (syntax-e id))))
id id))
(syntax->list #'(id ...)))])
(with-syntax ([(id* ...)
(map (lambda (id)
(datum->syntax
id
(string->symbol
(string-append
"typed-scheme/"
#,(symbol->string (syntax-e #'nm))
"/"
(symbol->string (syntax-e id))))
id id))
(syntax->list #'(id ...)))])
(syntax/loc stx (combine-in id* ...)))]))))]))