Rename control types to be consistent with other types

original commit: 904db66f6557a868ea616421253b8f0cc5e6bd27
2012-11-29 16:14:04 -05:00 · 2012-11-29 16:14:04 -05:00 · bca928688a
commit bca928688a
parent 37cbd6d5a9
14 changed files with 67 additions and 49 deletions
--- a/collects/tests/typed-racket/fail/control-test-1.rkt
+++ b/collects/tests/typed-racket/fail/control-test-1.rkt
@ -8,10 +8,10 @@
 (module typed typed/racket
  (provide call-f)

-  (: tag (Prompt-Tag String (Integer -> String)))
+  (: tag (Prompt-Tagof String (Integer -> String)))
  (define tag (make-continuation-prompt-tag))

-  (: call-f (((Prompt-Tag String (Integer -> String)) -> String) -> String))
+  (: call-f (((Prompt-Tagof String (Integer -> String)) -> String) -> String))
  (define (call-f f)
    (call-with-continuation-prompt
     (λ () (f tag))
--- a/collects/tests/typed-racket/fail/control-test-2.rkt
+++ b/collects/tests/typed-racket/fail/control-test-2.rkt
@ -8,10 +8,10 @@
 (module typed typed/racket
  (provide tag call-f)

-  (: tag (Prompt-Tag String (Integer -> String)))
+  (: tag (Prompt-Tagof String (Integer -> String)))
  (define tag (make-continuation-prompt-tag))

-  (: call-f (((Prompt-Tag String (Integer -> String)) -> String) -> String))
+  (: call-f (((Prompt-Tagof String (Integer -> String)) -> String) -> String))
  (define (call-f f)
    (call-with-continuation-prompt
     (λ () (f tag))
--- a/collects/tests/typed-racket/succeed/prompt-tag.rkt
+++ b/collects/tests/typed-racket/succeed/prompt-tag.rkt
@ -1,6 +1,6 @@
 #lang typed/racket

-(: pt (Prompt-Tag String (Integer -> Integer)))
+(: pt (Prompt-Tagof String (Integer -> Integer)))
 (define pt (make-continuation-prompt-tag))

 ;; Test abort
@ -9,7 +9,7 @@
 pt
 (λ: ([x : Integer]) x))

-(: pt2 (Prompt-Tag Integer ((Integer -> Integer) -> Integer)))
+(: pt2 (Prompt-Tagof Integer ((Integer -> Integer) -> Integer)))
 (define pt2 (make-continuation-prompt-tag))

 ;; Test call/comp & abort
@ -22,7 +22,7 @@
 (λ: ([f : (Integer -> Integer)]) (f 5)))

 ;; Test the default handler
-(: pt3 (Prompt-Tag Integer ((-> Integer) -> Integer)))
+(: pt3 (Prompt-Tagof Integer ((-> Integer) -> Integer)))
 (define pt3 (make-continuation-prompt-tag))

 (+ 2
--- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
@ -1355,7 +1355,7 @@
        ;; TODO: supporting default-continuation-prompt-tag means we need to
        ;;       specially handle abort-current-continuation in the type system
        ;(tc-e (default-continuation-prompt-tag) -Prompt-Tag)
-        (tc-e (let: ((pt : (Prompt-Tag Integer Integer) (make-continuation-prompt-tag)))
+        (tc-e (let: ((pt : (Prompt-Tagof Integer Integer) (make-continuation-prompt-tag)))
                   (continuation-marks #f pt)) -Cont-Mark-Set)
        (tc-e (let: ((set : Continuation-Mark-Set (current-continuation-marks)))
                   (continuation-mark-set? set)) #:ret (ret B (-FS -top -bot)))
--- a/collects/typed-racket/base-env/base-contracted.rkt
+++ b/collects/typed-racket/base-env/base-contracted.rkt
@ -8,7 +8,7 @@
         (types abbrev union)
         (utils any-wrap)
         (only-in (rep type-rep)
-                  make-Prompt-Tag))
+                  make-Prompt-Tagof))

 ;; this submodule defines the contracted versions
 (module contracted racket/base
@ -34,4 +34,5 @@

 ;; set up the type environment
 (define-initial-env initialize-contracted
-  [default-continuation-prompt-tag (-> (make-Prompt-Tag Univ (-> ManyUniv Univ)))])
+  [default-continuation-prompt-tag
+    (-> (make-Prompt-Tagof Univ (-> ManyUniv Univ)))])
--- a/collects/typed-racket/base-env/base-env.rkt
+++ b/collects/typed-racket/base-env/base-env.rkt
@ -37,9 +37,9 @@
          make-Ephemeron
          make-CustodianBox
          make-HeterogeneousVector
-          make-Continuation-Mark-Key
+          make-Continuation-Mark-Keyof
          make-Continuation-Mark-KeyTop
-          make-Prompt-Tag
+          make-Prompt-Tagof
          make-Prompt-TagTop
          make-ListDots))

@ -2017,26 +2017,30 @@
 [stx->list (-> (-Syntax Univ) (-lst (-Syntax Univ)))]
 [stx-list? (-> (-Syntax Univ) -Boolean)]

-;Section 9.4 (Continuations)
+;; Section 9.4 (Continuations)
 [call-with-continuation-prompt
 (-polydots (a b d c)
   (cl->*
-    (-> (-> b) (make-Prompt-Tag b (-> (-> d) d)) (Un b d))
-    (-> (-> b) (make-Prompt-Tag b (->... '() (c c) d)) (->... '() (c c) d)
+    (-> (-> b) (make-Prompt-Tagof b (-> (-> d) d)) (Un b d))
+    (-> (-> b) (make-Prompt-Tagof b (->... '() (c c) d)) (->... '() (c c) d)
        (Un b d))
    (-> (-> b) Univ)))]
 [abort-current-continuation
 (-polydots (a b d e c)
-   (->... (list (make-Prompt-Tag b (->... '() (c c) d))) (c c) e))]
-[make-continuation-prompt-tag (-poly (a b) (->opt [Sym] (make-Prompt-Tag a b)))]
+   (->... (list (make-Prompt-Tagof b (->... '() (c c) d))) (c c) e))]
+[make-continuation-prompt-tag
+ (-poly (a b) (->opt [Sym] (make-Prompt-Tagof a b)))]
 ;; default-continuation-prompt-tag is defined in "base-contracted.rkt"
-[call-with-current-continuation (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
+[call-with-current-continuation
+ (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
 [call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
 [call-with-composable-continuation
 (-polydots (b c a)
   (cl->*
-    (-> (->... '() (a a) b) (make-Prompt-Tag b c) (make-ValuesDots '() a 'a))))]
-[call-with-escape-continuation (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
+    (-> (->... '() (a a) b) (make-Prompt-Tagof b c)
+        (make-ValuesDots '() a 'a))))]
+[call-with-escape-continuation
+ (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
 [call/ec (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (Un a b)))]
 [call-with-continuation-barrier (-poly (a) (-> (-> a) a))]
 [continuation-prompt-available? (-> (make-Prompt-TagTop) B)]
@ -2044,33 +2048,46 @@
 [continuation-prompt-tag? (make-pred-ty (make-Prompt-TagTop))]
 [dynamic-wind (-poly (a) (-> (-> ManyUniv) (-> a) (-> ManyUniv) a))]

-;Section 9.5 (Continuation Marks)
-;continuation-marks needs type for continuations as other possible first argument
-[continuation-marks (->opt (Un (-val #f) -Thread) [(make-Prompt-TagTop)] -Cont-Mark-Set)]
+;; Section 9.5 (Continuation Marks)
+;; continuation-marks needs type for continuations as other
+;; possible first argument
+[continuation-marks
+ (->opt (Un (-val #f) -Thread) [(make-Prompt-TagTop)] -Cont-Mark-Set)]
 [current-continuation-marks (->opt [(make-Prompt-TagTop)] -Cont-Mark-Set)]
 [continuation-mark-set->list 
 (-poly (a)
        (cl->* 
-         (->opt -Cont-Mark-Set (make-Continuation-Mark-Key a) [(make-Prompt-TagTop)] (-lst a))
+         (->opt -Cont-Mark-Set (make-Continuation-Mark-Keyof a)
+                [(make-Prompt-TagTop)] (-lst a))
         (->opt -Cont-Mark-Set Univ [(make-Prompt-TagTop)] (-lst Univ))))]
 [continuation-mark-set->list* 
 (-poly (a b)
        (cl->* 
-         (->opt -Cont-Mark-Set (-lst (make-Continuation-Mark-Key a)) [b (make-Prompt-TagTop)]
+         (->opt -Cont-Mark-Set
+                (-lst (make-Continuation-Mark-Keyof a))
+                [b (make-Prompt-TagTop)]
                (-lst (-vec (Un a b))))
-         (->opt -Cont-Mark-Set (-lst Univ) [Univ (make-Prompt-TagTop)] (-lst (-vec Univ)))))]
+         (->opt -Cont-Mark-Set
+                (-lst Univ)
+                [Univ (make-Prompt-TagTop)]
+                (-lst (-vec Univ)))))]
 [continuation-mark-set-first 
 (-poly (a b)
        (cl->*
-         (-> (-opt -Cont-Mark-Set) (make-Continuation-Mark-Key a) (-opt a))
-         (->opt (-opt -Cont-Mark-Set) (make-Continuation-Mark-Key a) [b (make-Prompt-TagTop)]
+         (-> (-opt -Cont-Mark-Set) (make-Continuation-Mark-Keyof a)
+             (-opt a))
+         (->opt (-opt -Cont-Mark-Set) (make-Continuation-Mark-Keyof a)
+                [b (make-Prompt-TagTop)]
                (Un a b))
         (->opt (-opt -Cont-Mark-Set) Univ [Univ (make-Prompt-TagTop)] Univ)))]
-[call-with-immediate-continuation-mark (-poly (a) (->opt Univ (-> Univ a) [Univ] a))]
+[call-with-immediate-continuation-mark
+ (-poly (a) (->opt Univ (-> Univ a) [Univ] a))]
 [continuation-mark-key? (make-pred-ty (make-Continuation-Mark-KeyTop))]
 [continuation-mark-set? (make-pred-ty -Cont-Mark-Set)]
-[make-continuation-mark-key (-poly (a) (->opt [-Symbol] (make-Continuation-Mark-Key a)))]
-[continuation-mark-set->context (-> -Cont-Mark-Set (-lst (-pair (-opt Sym) Univ)))] ;TODO add srcloc
+[make-continuation-mark-key
+ (-poly (a) (->opt [-Symbol] (make-Continuation-Mark-Keyof a)))]
+[continuation-mark-set->context
+ (-> -Cont-Mark-Set (-lst (-pair (-opt Sym) Univ)))] ;TODO add srcloc


 ;Section 14.6 (Time)
--- a/collects/typed-racket/base-env/base-types.rkt
+++ b/collects/typed-racket/base-env/base-types.rkt
@ -169,5 +169,5 @@
 [Thread-Cellof (-poly (a) (-thread-cell a))]
 [Custodian-Boxof (-poly (a) (make-CustodianBox a))]

-[Continuation-Mark-Key (-poly (a) (make-Continuation-Mark-Key a))]
-[Prompt-Tag (-poly (a b) (make-Prompt-Tag a b))]
+[Continuation-Mark-Keyof (-poly (a) (make-Continuation-Mark-Keyof a))]
+[Prompt-Tagof (-poly (a b) (make-Prompt-Tagof a b))]
--- a/collects/typed-racket/infer/infer-unit.rkt
+++ b/collects/typed-racket/infer/infer-unit.rkt
@ -535,9 +535,9 @@
           (cset-meet (cg e e*) (cg e* e))]
          [((ThreadCell: e) (ThreadCell: e*))
           (cset-meet (cg e e*) (cg e* e))]
-          [((Continuation-Mark-Key: e) (Continuation-Mark-Key: e*))
+          [((Continuation-Mark-Keyof: e) (Continuation-Mark-Keyof: e*))
           (cset-meet (cg e e*) (cg e* e))]
-          [((Prompt-Tag: s t) (Prompt-Tag: s* t*))
+          [((Prompt-Tagof: s t) (Prompt-Tagof: s* t*))
           (cset-meet* (list (cg s s*) (cg s* s) (cg t t*) (cg t* t)))]
          [((Promise: e) (Promise: e*))
           (cg e e*)]
--- a/collects/typed-racket/private/type-contract.rkt
+++ b/collects/typed-racket/private/type-contract.rkt
@ -339,11 +339,11 @@
         #`(promise/c #,(t->c t))]
        [(Opaque: p? cert)
         #`(flat-named-contract (quote #,(syntax-e p?)) #,(cert p?))]
-        [(Continuation-Mark-Key: t)
+        [(Continuation-Mark-Keyof: t)
         (set-chaperone!)
         #`(continuation-mark-key/c #,(t->c t))]
        ;; TODO: this is not quite right for case->
-        [(Prompt-Tag: s (Function: (list (arr: (list ts ...) _ _ _ _))))
+        [(Prompt-Tagof: s (Function: (list (arr: (list ts ...) _ _ _ _))))
         (set-chaperone!)
         #`(prompt-tag/c #,@(map t->c ts) #:call/cc #,(t->c s))]
        ;; TODO
--- a/collects/typed-racket/rep/type-rep.rkt
+++ b/collects/typed-racket/rep/type-rep.rkt
@ -417,13 +417,13 @@
 ;; handler: the type of the prompt handler
 ;;   prompts with this tag will return a union of `body` 
 ;;   and the codomains of `handler`
-(def-type Prompt-Tag ([body Type/c] [handler Function?])
+(def-type Prompt-Tagof ([body Type/c] [handler Function?])
  [#:frees (λ (f) (combine-frees (list (make-invariant (f body))
                                       (make-invariant (f handler)))))]
  [#:key 'prompt-tag])

 ;; value: the type of allowable values
-(def-type Continuation-Mark-Key ([value Type/c])  
+(def-type Continuation-Mark-Keyof ([value Type/c])
  [#:frees (λ (f) (make-invariant (f value)))]
  [#:key 'continuation-mark-key])

--- a/collects/typed-racket/scribblings/reference/types.scrbl
+++ b/collects/typed-racket/scribblings/reference/types.scrbl
@ -389,7 +389,7 @@ The following types represent @rtech{prompt tag}s and
 keys for @rtech{continuation mark}s for use with delimited continuation
 functions and continuation mark functions.

-@defform[(Prompt-Tag s t)]{
+@defform[(Prompt-Tagof s t)]{
  A prompt tag to be used in a continuation prompt whose body
  produces the type @racket[_s] and whose handler has the type
  @racket[_t]. The type @racket[_t] must be a function type.
@ -401,7 +401,7 @@ functions and continuation mark functions.
  @ex[(make-continuation-prompt-tag 'prompt-tag)]
 }

-@defform[(Continuation-Mark-Key t)]{
+@defform[(Continuation-Mark-Keyof t)]{
  A continuation mark key that is used for continuation mark
  operations such as @racket[with-continuation-mark] and
  @racket[continuation-mark-set->list]. The type @racket[_t]
--- a/collects/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-racket/typecheck/tc-expr-unit.rkt
@ -328,7 +328,7 @@
        [(with-continuation-mark e1 e2 e3)
         (define key-t (single-value #'e1))
         (match key-t
-           [(tc-result1: (Continuation-Mark-Key: rhs))
+           [(tc-result1: (Continuation-Mark-Keyof: rhs))
            (tc-expr/check/type #'e2 rhs)
            (tc-expr/check #'e3 expected)]
           [(? (λ _ (and (identifier? #'e1)
@ -434,7 +434,7 @@
      [(with-continuation-mark e1 e2 e3)
       (define key-t (single-value #'e1))
       (match key-t
-         [(tc-result1: (Continuation-Mark-Key: rhs))
+         [(tc-result1: (Continuation-Mark-Keyof: rhs))
          (tc-expr/check/type #'e2 rhs)
          (tc-expr #'e3)]
         [(? (λ _ (and (identifier? #'e1)
--- a/collects/typed-racket/types/printer.rkt
+++ b/collects/typed-racket/types/printer.rkt
@ -281,10 +281,10 @@
         (fp "(Parameterof ~a)" in)
         (fp "(Parameterof ~a ~a)" in out))]
    [(Hashtable: k v) (fp "(HashTable ~a ~a)" k v)]
-    [(Continuation-Mark-Key: rhs)
-     (fp "(Continuation-Mark-Key ~a)" rhs)]
-    [(Prompt-Tag: body handler)
-     (fp "(Prompt-Tag ~a ~a)" body handler)]
+    [(Continuation-Mark-Keyof: rhs)
+     (fp "(Continuation-Mark-Keyof ~a)" rhs)]
+    [(Prompt-Tagof: body handler)
+     (fp "(Prompt-Tagof ~a ~a)" body handler)]
    #;[(Poly-unsafe: n b) (fp "(unsafe-poly ~a ~a ~a)" (Type-seq c) n b)]
    [(Poly-names: names body)
     #;(eprintf "POLY SEQ: ~a\n" (Type-seq body))
--- a/collects/typed-racket/types/subtype.rkt
+++ b/collects/typed-racket/types/subtype.rkt
@ -423,8 +423,8 @@
              [((Hashtable: _ _) (HashtableTop:)) A0]
              ;; TODO: subtyping for two `Prompt-Tagof`s with recursive types
              ;;       may be rejected unnecessarily
-              [((Prompt-Tag: _ _) (Prompt-TagTop:)) A0]
-              [((Continuation-Mark-Key: _) (Continuation-Mark-KeyTop:)) A0]
+              [((Prompt-Tagof: _ _) (Prompt-TagTop:)) A0]
+              [((Continuation-Mark-Keyof: _) (Continuation-Mark-KeyTop:)) A0]
              ;; subtyping on structs follows the declared hierarchy
              [((Struct: nm (? Type? parent) _ _ _ _) other)
               ;(dprintf "subtype - hierarchy : ~a ~a ~a\n" nm parent other)