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

Rename a parameter to better reflect what it's for.

Browse Source 
original commit: cef410f5e2e6e5728cf1bc8769607f637365683f
This commit is contained in:
Vincent St-Amour 2011-08-10 17:23:05 -04:00
parent f38df9c69b
commit 5d94df5648
6 changed files with 47 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/typed-scheme/core.rkt
View File

@ -31,7 +31,7 @@
(;; pmb = #%plain-module-begin
[(pmb . body2) new-mod]
;; add in syntax property on useless expression to draw check-syntax arrows
[check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))]
[check-syntax-help (syntax-property #'(void) 'disappeared-use (disappeared-use-todo))]
;; perform the provide transformation from [Culpepper 07]
[transformed-body (remove-provides #'body2)]
;; add the real definitions of contracts on requires

2
collects/typed-scheme/env/type-name-env.rkt vendored
View File

@ -38,7 +38,7 @@
(define (lookup-type-name id [k (lambda () (lookup-type-fail id))])
(begin0
(module-identifier-mapping-get the-mapping id k)
(add-type-name-reference id)))
(add-disappeared-use id)))
;; map over the-mapping, producing a list

72
collects/typed-scheme/private/parse-type.rkt
View File

@ -71,13 +71,13 @@
[((~and kw t:All) (vars:id ... v:id dd:ddd) . t)
(let* ([vars (map syntax-e (syntax->list #'(vars ...)))]
[v (syntax-e #'v)])
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(extend-indexes v
(extend-tvars vars
(make-PolyDots (append vars (list v)) (parse-all-body #'t)))))]
[((~and kw t:All) (vars:id ...) . t)
(let* ([vars (map syntax-e (syntax->list #'(vars ...)))])
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(extend-tvars vars
(make-Poly vars (parse-all-body #'t))))]
[(t:All (_:id ...) _ _ _ ...) (tc-error "All: too many forms in body of All type")]
@ -161,7 +161,7 @@
#:fail-unless (not (syntax->list #'rst)) #f
(-pair (parse-type #'fst) (parse-type #'rst))]
[((~and kw t:Class) (pos-args ...) ([fname fty . rest] ...) ([mname mty] ...))
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(make-Class
(map parse-type (syntax->list #'(pos-args ...)))
(map list
@ -175,35 +175,35 @@
(map syntax-e (syntax->list #'(mname ...)))
(map parse-type (syntax->list #'(mty ...)))))]
[((~and kw t:Refinement) p?:id)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(match (lookup-type/lexical #'p?)
[(and t (Function: (list (arr: (list dom) _ #f #f '()))))
(make-Refinement dom #'p? (syntax-local-certifier))]
[t (tc-error "cannot declare refinement for non-predicate ~a" t)])]
[((~and kw t:Instance) t)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([v (parse-type #'t)])
(if (not (or (Mu? v) (Class? v) (Union? v) (Error? v)))
(begin (tc-error/delayed "Argument to Instance must be a class type, got ~a" v)
(make-Instance (Un)))
(make-Instance v)))]
[((~and kw t:List) ts ...)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(parse-list-type stx)]
[((~and kw t:List*) ts ... t)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-Tuple* (map parse-type (syntax->list #'(ts ...))) (parse-type #'t))]
[((~and kw t:Vector) ts ...)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(make-HeterogenousVector (map parse-type (syntax->list #'(ts ...))))]
[((~and kw cons) fst rst)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-pair (parse-type #'fst) (parse-type #'rst))]
[((~and kw t:pred) t)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(make-pred-ty (parse-type #'t))]
[((~and kw (~or case-lambda t:case->)) tys ...)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(make-Function
(for/list ([ty (syntax->list #'(tys ...))])
(let ([t (parse-type ty)])
@ -213,44 +213,44 @@
ty
"Component of case-lambda type was not a function clause")]))))]
#;[((~and kw t:Vectorof) t)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(make-Vector (parse-type #'t))]
[((~and kw t:Rec) x:id t)
#:fail-unless (enable-mu-parsing) "Recursive types not allowed"
(let* ([var (syntax-e #'x)]
[tvar (make-F var)])
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(extend-tvars (list var)
(let ([t (parse-type #'t)])
(if (memq var (fv t))
(make-Mu var t)
t))))]
[((~and kw t:U) ts ...)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(apply Un (map parse-type (syntax->list #'(ts ...))))]
[((~and kw quote) (t1 . t2))
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-pair (parse-type #'(quote t1)) (parse-type #'(quote t2)))]
[((~and kw quote) t)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-val (syntax->datum #'t))]
[((~and kw t:All) . rest)
(parse-all-type stx parse-type)]
[((~and kw t:Opaque) p?)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(make-Opaque #'p? (syntax-local-certifier))]
[((~and kw t:Parameter) t)
(let ([ty (parse-type #'t)])
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-Param ty ty))]
[((~and kw t:Parameter) t1 t2)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-Param (parse-type #'t1) (parse-type #'t2))]
;; curried function notation
[((~and dom:non-keyword-ty (~not t:->)) ...
(~and kw t:->)
(~and (~seq rest-dom ...) (~seq (~or _ (~between t:-> 1 +inf.0)) ...)))
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([doms (for/list ([d (syntax->list #'(dom ...))])
(parse-type d))])
(make-Function
@ -258,18 +258,18 @@
doms
(parse-type (syntax/loc stx (rest-dom ...)))))))]
[(dom ... (~and kw t:->) rng : latent:full-latent)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
(->* (map parse-type (syntax->list #'(dom ...)))
(parse-type #'rng)
: (-FS (attribute latent.positive) (attribute latent.negative))
: (attribute latent.object))]
[(dom (~and kw t:->) rng : ~! latent:simple-latent-filter)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
(make-pred-ty (list (parse-type #'dom)) (parse-type #'rng) (attribute latent.type) 0 (attribute latent.path))]
[(dom:non-keyword-ty ... rest:non-keyword-ty ddd:star kws:keyword-tys ... (~and kw t:->) rng)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(make-Function
(list (make-arr
(map parse-type (syntax->list #'(dom ...)))
@ -277,7 +277,7 @@
#:rest (parse-type #'rest)
#:kws (attribute kws.Keyword))))]
[(dom:non-keyword-ty ... rest:non-keyword-ty :ddd/bound (~and kw t:->) rng)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let* ([bnd (syntax-e #'bound)])
(unless (bound-index? bnd)
(tc-error/stx #'bound
@ -291,7 +291,7 @@
(parse-type #'rest))
bnd))))]
[(dom:non-keyword-ty ... rest:non-keyword-ty _:ddd (~and kw t:->) rng)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([var (infer-index stx)])
(make-Function
(list
@ -301,12 +301,12 @@
var))))]
#| ;; has to be below the previous one
[(dom:expr ... (~and kw t:->) rng)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(->* (map parse-type (syntax->list #'(dom ...)))
(parse-values-type #'rng))] |#
;; use expr to rule out keywords
[(dom:non-keyword-ty ... kws:keyword-tys ... (~and kw t:->) rng)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([doms (for/list ([d (syntax->list #'(dom ...))])
(parse-type d))])
(make-Function
@ -330,11 +330,11 @@
=>
(lambda (t)
;(printf "found a type alias ~a\n" #'id)
(add-type-name-reference #'id)
(add-disappeared-use #'id)
t)]
;; if it's a type name, we just use the name
[(lookup-type-name #'id (lambda () #f))
(add-type-name-reference #'id)
(add-disappeared-use #'id)
;(printf "found a type name ~a\n" #'id)
(make-Name #'id)]
[(free-identifier=? #'id #'t:->)
@ -396,7 +396,7 @@
(parameterize ([current-orig-stx stx])
(syntax-parse stx #:literals (t:List)
[((~and kw t:List) tys ... dty :ddd/bound)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([var (syntax-e #'bound)])
(unless (bound-index? var)
(if (bound-tvar? var)
@ -408,7 +408,7 @@
(parse-type #'dty))
var)))]
[((~and kw t:List) tys ... dty _:ddd)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([var (infer-index stx)])
(-Tuple* (map parse-type (syntax->list #'(tys ...)))
(make-ListDots
@ -416,14 +416,14 @@
(parse-type #'dty))
var)))]
[((~and kw t:List) tys ...)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-Tuple (map parse-type (syntax->list #'(tys ...))))])))
(define (parse-values-type stx)
(parameterize ([current-orig-stx stx])
(syntax-parse stx #:literals (values t:All)
[((~and kw values) tys ... dty :ddd/bound)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([var (syntax-e #'bound)])
(unless (bound-index? var)
(if (bound-tvar? var)
@ -434,14 +434,14 @@
(parse-type #'dty))
var))]
[((~and kw values) tys ... dty _:ddd)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(let ([var (infer-index stx)])
(make-ValuesDots (map parse-type (syntax->list #'(tys ...)))
(extend-tvars (list var)
(parse-type #'dty))
var))]
[((~and kw values) tys ...)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(-values (map parse-type (syntax->list #'(tys ...))))]
[t
(-values (list (parse-type #'t)))])))
@ -449,7 +449,7 @@
(define (parse-tc-results stx)
(syntax-parse stx #:literals (values)
[((~and kw values) t ...)
(add-type-name-reference #'kw)
(add-disappeared-use #'kw)
(ret (map parse-type (syntax->list #'(t ...)))
(map (lambda (x) (make-NoFilter)) (syntax->list #'(t ...)))
(map (lambda (x) (make-NoObject)) (syntax->list #'(t ...))))]

6
collects/typed-scheme/private/with-types.rkt
View File

@ -82,8 +82,8 @@
(cons (syntax-e id) ty)))
(type-alias-env-map (lambda (id ty)
(cons (syntax-e id) ty)))))]
;; reinitialize seen type variables
[type-name-references null]
;; reinitialize disappeared uses
[disappeared-use-todo null]
;; for error reporting
[orig-module-stx stx]
[expanded-module-stx expanded-body])
@ -99,7 +99,7 @@
[(ex-cnt ...) ex-cnts]
[(region-cnt ...) region-cnts]
[body (maybe-optimize expanded-body)]
[check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))])
[check-syntax-help (syntax-property #'(void) 'disappeared-use (disappeared-use-todo))])
(if expr?
(quasisyntax/loc stx
(begin check-syntax-help

4
collects/typed-scheme/tc-setup.rkt
View File

@ -56,8 +56,8 @@
(cons (syntax-e id) ty)))
(type-alias-env-map (lambda (id ty)
(cons (syntax-e id) ty)))))]
;; reinitialize seen type variables
[type-name-references null])
;; reinitialize disappeared uses
[disappeared-use-todo null])
(do-time "Initialized Envs")
(let ([fully-expanded-stx (disarm* (local-expand stx expand-ctxt null))])
(when (show-input?)

8
collects/typed-scheme/utils/tc-utils.rkt
View File

@ -154,11 +154,11 @@ don't depend on any other portion of the system
;; are we currently expanding in a typed module (or top-level form)?
(define typed-context? (box #f))
;; what type names have been referred to in this module?
(define type-name-references (make-parameter '()))
;; list of syntax objects that should count as disappeared uses
(define disappeared-use-todo (make-parameter '()))
(define (add-type-name-reference t)
(type-name-references (cons t (type-name-references))))
(define (add-disappeared-use t)
(disappeared-use-todo (cons t (disappeared-use-todo))))
;; environment constructor
(define-syntax (make-env stx)