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

Use promises for current-type-names.

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2012-07-13 13:19:04 -04:00
parent b33509bc0d
commit 683f8e4e4b
4 changed files with 10 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/typed-racket/private/with-types.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require racket/require (require racket/require racket/promise
(for-template (for-template
(except-in racket/base for for* with-handlers lambda λ define) (except-in racket/base for for* with-handlers lambda λ define)
"../base-env/prims.rkt" "../base-env/prims.rkt"
@ -79,7 +79,7 @@
;; this parameter is just for printing types ;; this parameter is just for printing types
;; this is a parameter to avoid dependency issues ;; this is a parameter to avoid dependency issues
[current-type-names [current-type-names
(lambda () (delay
(append (append
(type-name-env-map (lambda (id ty) (type-name-env-map (lambda (id ty)
(cons (syntax-e id) ty))) (cons (syntax-e id) ty)))

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

@ -2,7 +2,7 @@
(require (rename-in "utils/utils.rkt" [infer r:infer]) (require (rename-in "utils/utils.rkt" [infer r:infer])
(except-in syntax/parse id) (except-in syntax/parse id)
racket/pretty racket/pretty racket/promise
(private type-contract) (private type-contract)
(types utils convenience) (types utils convenience)
(typecheck typechecker provide-handling tc-toplevel) (typecheck typechecker provide-handling tc-toplevel)
@ -50,7 +50,7 @@
;; this parameter is just for printing types ;; this parameter is just for printing types
;; this is a parameter to avoid dependency issues ;; this is a parameter to avoid dependency issues
[current-type-names [current-type-names
(lambda () (delay
(append (append
(type-name-env-map (lambda (id ty) (type-name-env-map (lambda (id ty)
(cons (syntax-e id) ty))) (cons (syntax-e id) ty)))

6
collects/typed-racket/types/printer.rkt
View File

@ -1,6 +1,6 @@
#lang racket/base #lang racket/base
(require racket/require racket/match unstable/sequence racket/string (require racket/require racket/match unstable/sequence racket/string racket/promise
(prefix-in s: srfi/1) (prefix-in s: srfi/1)
(path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt" (path-up "rep/type-rep.rkt" "rep/filter-rep.rkt" "rep/object-rep.rkt"
"rep/rep-utils.rkt" "types/abbrev.rkt" "types/subtype.rkt" "rep/rep-utils.rkt" "types/abbrev.rkt" "types/subtype.rkt"
@ -21,7 +21,7 @@
;; has-name : Type -> Maybe[Symbol] ;; has-name : Type -> Maybe[Symbol]
(define (has-name? t) (define (has-name? t)
(and print-aliases (and print-aliases
(for/first ([(n t*) (in-pairs (in-list ((current-type-names))))] (for/first ([(n t*) (in-pairs (in-list (force (current-type-names))))]
#:when (and (Type? t*) (type-equal? t t*))) #:when (and (Type? t*) (type-equal? t t*)))
n))) n)))
@ -86,7 +86,7 @@
[(cons name (and t* (Union: elts))) [(cons name (and t* (Union: elts)))
(subtype t* t)] (subtype t* t)]
[_ #f])) [_ #f]))
((current-type-names)))) (force (current-type-names))))
;; names and the sets themselves (not the union types) ;; names and the sets themselves (not the union types)
;; we use srfi/1 lsets as sets, to use custom type equality. ;; we use srfi/1 lsets as sets, to use custom type equality.
(define candidates (define candidates

4
collects/typed-racket/utils/tc-utils.rkt
View File

@ -6,7 +6,7 @@ don't depend on any other portion of the system
|# |#
(provide (all-defined-out) (all-from-out "disappeared-use.rkt")) (provide (all-defined-out) (all-from-out "disappeared-use.rkt"))
(require "syntax-traversal.rkt" racket/dict "disappeared-use.rkt" (require "syntax-traversal.rkt" racket/dict "disappeared-use.rkt" racket/promise
syntax/parse (for-syntax racket/base syntax/parse) racket/match) syntax/parse (for-syntax racket/base syntax/parse) racket/match)
;; a parameter representing the original location of the syntax being ;; a parameter representing the original location of the syntax being
@ -151,7 +151,7 @@ don't depend on any other portion of the system
;; parameter for currently-defined type aliases ;; parameter for currently-defined type aliases
;; this is used only for printing type names ;; this is used only for printing type names
(define current-type-names (make-parameter (lambda () '()))) (define current-type-names (make-parameter (delay '())))
;; for reporting internal errors in the type checker ;; for reporting internal errors in the type checker
(define-struct (exn:fail:tc exn:fail) ()) (define-struct (exn:fail:tc exn:fail) ())