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

racket/contract: rename prompt/c & continuation-mark/c

Browse Source 
The new names are `prompt-tag/c` and `continuation-mark-key/c`
to keep the names consistent with the values that are being
contracted. Also updated the HISTORY file.
This commit is contained in:
Asumu Takikawa 2012-06-26 21:09:55 -04:00
parent fcab398081
commit 095d47fc3d
4 changed files with 113 additions and 102 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
collects/racket/contract/private/misc.rkt
View File

@ -35,8 +35,8 @@
none/c
make-none/c
prompt/c
continuation-mark/c
prompt-tag/c
continuation-mark-key/c
chaperone-contract?
impersonator-contract?
@ -946,21 +946,24 @@
(define/final-prop none/c (make-none/c 'none/c))
;; prompt/c
(define/subexpression-pos-prop (prompt/c . ctc-args)
;; prompt-tag/c
(define/subexpression-pos-prop (prompt-tag/c . ctc-args)
(define ctcs
(map (λ (ctc-arg)
(coerce-contract 'prompt/c ctc-arg))
(coerce-contract 'prompt-tag/c ctc-arg))
ctc-args))
(cond [(andmap chaperone-contract? ctcs) (chaperone-prompt/c ctcs)]
[else (impersonator-prompt/c ctcs)]))
(cond [(andmap chaperone-contract? ctcs)
(chaperone-prompt-tag/c ctcs)]
[else
(impersonator-prompt-tag/c ctcs)]))
(define (prompt/c-name ctc)
(define (prompt-tag/c-name ctc)
(apply build-compound-type-name
(cons 'prompt/c (base-prompt/c-ctcs ctc))))
(cons 'prompt-tag/c (base-prompt-tag/c-ctcs ctc))))
(define ((prompt/c-proj proxy) ctc)
(define ho-projs (map contract-projection (base-prompt/c-ctcs ctc)))
(define ((prompt-tag/c-proj proxy) ctc)
(define ho-projs
(map contract-projection (base-prompt-tag/c-ctcs ctc)))
(λ (blame)
(define proj1
(λ vs
@ -981,47 +984,50 @@
val))
(proxy val proj1 proj2))))
(define ((prompt/c-first-order ctc) v)
(define ((prompt-tag/c-first-order ctc) v)
(continuation-prompt-tag? v))
(define (prompt/c-stronger? this that)
(and (base-prompt/c? that)
(define (prompt-tag/c-stronger? this that)
(and (base-prompt-tag/c? that)
(andmap (λ (this that) (contract-stronger? this that))
(base-prompt/c-ctcs this)
(base-prompt/c-ctcs that))))
(base-prompt-tag/c-ctcs this)
(base-prompt-tag/c-ctcs that))))
(define-struct base-prompt/c (ctcs))
(define-struct base-prompt-tag/c (ctcs))
(define-struct (chaperone-prompt/c base-prompt/c) ()
(define-struct (chaperone-prompt-tag/c base-prompt-tag/c) ()
#:property prop:chaperone-contract
(build-chaperone-contract-property
#:projection (prompt/c-proj chaperone-prompt-tag)
#:first-order prompt/c-first-order
#:stronger prompt/c-stronger?
#:name prompt/c-name))
#:projection (prompt-tag/c-proj chaperone-prompt-tag)
#:first-order prompt-tag/c-first-order
#:stronger prompt-tag/c-stronger?
#:name prompt-tag/c-name))
(define-struct (impersonator-prompt/c base-prompt/c) ()
(define-struct (impersonator-prompt-tag/c base-prompt-tag/c) ()
#:property prop:contract
(build-contract-property
#:projection (prompt/c-proj impersonate-prompt-tag)
#:first-order prompt/c-first-order
#:stronger prompt/c-stronger?
#:name prompt/c-name))
#:projection (prompt-tag/c-proj impersonate-prompt-tag)
#:first-order prompt-tag/c-first-order
#:stronger prompt-tag/c-stronger?
#:name prompt-tag/c-name))
;; continuation-mark/c
(define/subexpression-pos-prop (continuation-mark/c ctc-arg)
(define ctc (coerce-contract 'continuation-mark/c ctc-arg))
(cond [(chaperone-contract? ctc) (chaperone-continuation-mark/c ctc)]
[else (impersonator-continuation-mark/c ctc)]))
;; continuation-mark-key/c
(define/subexpression-pos-prop (continuation-mark-key/c ctc-arg)
(define ctc (coerce-contract 'continuation-mark-key/c ctc-arg))
(cond [(chaperone-contract? ctc)
(chaperone-continuation-mark-key/c ctc)]
[else
(impersonator-continuation-mark-key/c ctc)]))
(define (continuation-mark/c-name ctc)
(define (continuation-mark-key/c-name ctc)
(build-compound-type-name
'continuation-mark/c
(base-continuation-mark/c-ctc ctc)))
'continuation-mark-key/c
(base-continuation-mark-key/c-ctc ctc)))
(define ((continuation-mark/c-proj proxy) ctc)
(define ho-proj (contract-projection (base-continuation-mark/c-ctc ctc)))
(define ((continuation-mark-key/c-proj proxy) ctc)
(define ho-proj
(contract-projection (base-continuation-mark-key/c-ctc ctc)))
(λ (blame)
(define proj1 (λ (v) ((ho-proj blame) v)))
(define proj2 (λ (v) ((ho-proj (blame-swap blame)) v)))
@ -1034,32 +1040,36 @@
val))
(proxy val proj1 proj2))))
(define ((continuation-mark/c-first-order ctc) v)
(define ((continuation-mark-key/c-first-order ctc) v)
(continuation-mark-key? v))
(define (continuation-mark/c-stronger? this that)
(and (base-continuation-mark/c? that)
(define (continuation-mark-key/c-stronger? this that)
(and (base-continuation-mark-key/c? that)
(contract-stronger?
(base-continuation-mark/c-ctc this)
(base-continuation-mark/c-ctc that))))
(base-continuation-mark-key/c-ctc this)
(base-continuation-mark-key/c-ctc that))))
(define-struct base-continuation-mark/c (ctc))
(define-struct base-continuation-mark-key/c (ctc))
(define-struct (chaperone-continuation-mark/c base-continuation-mark/c) ()
(define-struct (chaperone-continuation-mark-key/c
base-continuation-mark-key/c)
()
#:property prop:chaperone-contract
(build-chaperone-contract-property
#:projection (continuation-mark/c-proj chaperone-continuation-mark-key)
#:first-order continuation-mark/c-first-order
#:stronger continuation-mark/c-stronger?
#:name continuation-mark/c-name))
#:projection (continuation-mark-key/c-proj chaperone-continuation-mark-key)
#:first-order continuation-mark-key/c-first-order
#:stronger continuation-mark-key/c-stronger?
#:name continuation-mark-key/c-name))
(define-struct (impersonator-continuation-mark/c base-continuation-mark/c) ()
(define-struct (impersonator-continuation-mark-key/c
base-continuation-mark-key/c)
()
#:property prop:contract
(build-contract-property
#:projection (continuation-mark/c-proj impersonate-continuation-mark-key)
#:first-order continuation-mark/c-first-order
#:stronger continuation-mark/c-stronger?
#:name continuation-mark/c-name))
#:projection (continuation-mark-key/c-proj impersonate-continuation-mark-key)
#:first-order continuation-mark-key/c-first-order
#:stronger continuation-mark-key/c-stronger?
#:name continuation-mark-key/c-name))
(define (flat-contract-predicate x)

8
collects/scribblings/reference/contracts.scrbl
View File

@ -490,7 +490,7 @@ to the input. The result will be a copy for immutable hash tables, and either a
}
@defproc[(prompt/c [contract contract?] ...) contract?]{
@defproc[(prompt-tag/c [contract contract?] ...) contract?]{
Takes any number of contracts and returns a contract that recognizes
continuation prompt tags and will check any aborts or prompt handlers that
use the contracted prompt tag.
@ -505,7 +505,7 @@ an @tech{impersonator} contract.
@examples[#:eval (contract-eval)
(define/contract tag
(prompt/c (-> number? string?))
(prompt-tag/c (-> number? string?))
(make-continuation-prompt-tag))
(call-with-continuation-prompt
@ -520,7 +520,7 @@ an @tech{impersonator} contract.
}
@defproc[(continuation-mark/c [contract contract?]) contract?]{
@defproc[(continuation-mark-key/c [contract contract?]) contract?]{
Takes a single contract and returns a contract that recognizes
continuation marks and will check any mappings of marks to values
or any accesses of the mark value.
@ -531,7 +531,7 @@ an @tech{impersonator} contract.
@examples[#:eval (contract-eval)
(define/contract mark-key
(continuation-mark/c (-> symbol (listof symbol?)))
(continuation-mark-key/c (-> symbol? (listof symbol?)))
(make-continuation-mark-key))
(with-continuation-mark

90
collects/tests/racket/contract-test.rktl
View File

@ -4046,23 +4046,23 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; prompt/c
;; prompt-tag/c
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(test/spec-passed
'prompt/c-fo-1
'(contract (prompt/c string?)
'prompt-tag/c-fo-1
'(contract (prompt-tag/c string?)
(make-continuation-prompt-tag)
'pos 'neg))
(test/pos-blame
'prompt/c-fo-2
'(contract (prompt/c string?) 5 'pos 'neg))
'prompt-tag/c-fo-2
'(contract (prompt-tag/c string?) 5 'pos 'neg))
(test/spec-passed
'prompt/c-ho-1
'(let ([pt (contract (prompt/c number?)
'prompt-tag/c-ho-1
'(let ([pt (contract (prompt-tag/c number?)
(make-continuation-prompt-tag)
'pos
'neg)])
@ -4072,8 +4072,8 @@
(λ (x) (+ x 1)))))
(test/neg-blame
'prompt/c-ho-2
'(let ([pt (contract (prompt/c string?)
'prompt-tag/c-ho-2
'(let ([pt (contract (prompt-tag/c string?)
(make-continuation-prompt-tag)
'pos
'neg)])
@ -4083,8 +4083,8 @@
(λ (x) (+ x 1)))))
(test/neg-blame
'prompt/c-ho-3
'(let ([pt (contract (prompt/c (-> string? number?))
'prompt-tag/c-ho-3
'(let ([pt (contract (prompt-tag/c (-> string? number?))
(make-continuation-prompt-tag)
'pos
'neg)])
@ -4094,8 +4094,8 @@
(λ (x) (x 8)))))
(test/neg-blame
'prompt/c-ho-4
'(let ([pt (contract (prompt/c (-> string? number?))
'prompt-tag/c-ho-4
'(let ([pt (contract (prompt-tag/c (-> string? number?))
(make-continuation-prompt-tag)
'pos
'neg)])
@ -4105,10 +4105,10 @@
(λ (x) (x "potato")))))
(test/pos-blame
'prompt/c-ho-5
'prompt-tag/c-ho-5
'(let* ([pt (make-continuation-prompt-tag)]
[do-prompt (contract
(-> (-> (prompt/c (-> number? number?))
(-> (-> (prompt-tag/c (-> number? number?))
any)
number?)
(λ (f) (call-with-continuation-prompt
@ -4121,10 +4121,10 @@
(abort-current-continuation pt (λ (v) (+ v 1)))))))
(test/spec-failed
'prompt/c-ho-5
'prompt-tag/c-ho-5
'(let* ([pt (make-continuation-prompt-tag)]
[do-prompt (contract
(-> (-> (prompt/c (-> number? number?))
(-> (-> (prompt-tag/c (-> number? number?))
any)
number?)
(λ (f) (call-with-continuation-prompt
@ -4134,7 +4134,7 @@
'A
'B)]
[do-prompt2 (contract
(-> (-> (prompt/c (-> string? number?))
(-> (-> (prompt-tag/c (-> string? number?))
any)
number?)
do-prompt
@ -4145,8 +4145,8 @@
"B")
(test/neg-blame
'prompt/c-ho-6
'(let ([pt (contract (prompt/c string? number?)
'prompt-tag/c-ho-6
'(let ([pt (contract (prompt-tag/c string? number?)
(make-continuation-prompt-tag)
'pos
'neg)])
@ -4156,8 +4156,8 @@
(λ (x y) (values x y)))))
(test/spec-passed
'prompt/c-ho-7
'(let ([pt (contract (prompt/c string? number?)
'prompt-tag/c-ho-7
'(let ([pt (contract (prompt-tag/c string? number?)
(make-continuation-prompt-tag)
'pos
'neg)])
@ -4168,24 +4168,24 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; prompt/c
;; continuation-mark-key/c
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(test/spec-passed
'continuation-mark/c-fo-1
'(contract (continuation-mark/c string?)
'continuation-mark-key/c-fo-1
'(contract (continuation-mark-key/c string?)
(make-continuation-mark-key)
'pos 'neg))
(test/pos-blame
'continuation-mark/c-fo-2
'(contract (continuation-mark/c string?) 5 'pos 'neg))
'continuation-mark-key/c-fo-2
'(contract (continuation-mark-key/c string?) 5 'pos 'neg))
;; TODO: Does not pass due to compiler optimization
;(test/neg-blame
; 'continuation-mark/c-ho-1
; '(let ([mark (contract (continuation-mark/c number?)
; 'continuation-mark-key/c-ho-1
; '(let ([mark (contract (continuation-mark-key/c number?)
; (make-continuation-mark-key)
; 'pos
; 'neg)])
@ -4193,8 +4193,8 @@
; 42)))
(test/spec-passed
'continuation-mark/c-ho-2
'(let ([mark (contract (continuation-mark/c number?)
'continuation-mark-key/c-ho-2
'(let ([mark (contract (continuation-mark-key/c number?)
(make-continuation-mark-key)
'pos
'neg)])
@ -4203,8 +4203,8 @@
(current-continuation-marks) mark))))
(test/neg-blame
'continuation-mark/c-ho-3
'(let ([mark (contract (continuation-mark/c number?)
'continuation-mark-key/c-ho-3
'(let ([mark (contract (continuation-mark-key/c number?)
(make-continuation-mark-key)
'pos
'neg)])
@ -4213,9 +4213,9 @@
(current-continuation-marks) mark))))
(test/neg-blame
'continuation-mark/c-ho-4
'continuation-mark-key/c-ho-4
'(let* ([mark (make-continuation-mark-key)]
[do-mark (contract (-> (-> (continuation-mark/c (-> number? number?))
[do-mark (contract (-> (-> (continuation-mark-key/c (-> number? number?))
number?)
number?)
(lambda (f)
@ -4230,9 +4230,9 @@
"bad")))))
(test/pos-blame
'continuation-mark/c-ho-5
'continuation-mark-key/c-ho-5
'(let* ([mark (make-continuation-mark-key)]
[do-mark (contract (-> (-> (continuation-mark/c (-> number? number?))
[do-mark (contract (-> (-> (continuation-mark-key/c (-> number? number?))
number?)
number?)
(lambda (f)
@ -4247,9 +4247,9 @@
0)))))
(test/spec-passed
'continuation-mark/c-ho-6
'continuation-mark-key/c-ho-6
'(let* ([mark (make-continuation-mark-key)]
[do-mark (contract (-> (-> (continuation-mark/c (-> number? number?))
[do-mark (contract (-> (-> (continuation-mark-key/c (-> number? number?))
number?)
number?)
(lambda (f)
@ -4264,8 +4264,8 @@
0)))))
(test/neg-blame
'continuation-mark/c-ho-7
'(let ([mark (contract (continuation-mark/c (-> number? number?))
'continuation-mark-key/c-ho-7
'(let ([mark (contract (continuation-mark-key/c (-> number? number?))
(make-continuation-mark-key)
'pos
'neg)])
@ -4275,8 +4275,8 @@
5))))
(test/spec-passed
'continuation-mark/c-ho-8
'(let ([mark (contract (continuation-mark/c (-> number? number?))
'continuation-mark-key/c-ho-8
'(let ([mark (contract (continuation-mark-key/c (-> number? number?))
(make-continuation-mark-key)
'pos
'neg)])
@ -4286,9 +4286,9 @@
0))))
(test/pos-blame
'continuation-mark/c-ho-9
'continuation-mark-key/c-ho-9
'(let* ([mark (make-continuation-mark-key)]
[do-mark (contract (-> (continuation-mark/c (-> number? number?))
[do-mark (contract (-> (continuation-mark-key/c (-> number? number?))
number?)
(lambda (mark)
((continuation-mark-set-first

1
doc/release-notes/racket/HISTORY.txt
View File

@ -2,6 +2,7 @@ Version 5.3.0.12
racket/base: added impersonate-continuation-mark-key,
chaperone-continuation-mark-key, make-continuation-mark-key,
continuation-mark-key?
racket/contract: added prompt-tag/c and continuation-mark-key/c
Version 5.3.0.11
Changed contract on date second field to disallow 61, since