Now change box/c to use proxies or chaperones appropriately.
Create a mzlib/contract compatible version of the old box/c and use that for mzlib/contract. Change the docs so that the docs for mzlib/contract contain the right information. Fix the typed-scheme implementation to only force flat box (or hash) contracts when it already is required to be flat. Otherwise, allow non-flat contracts for the element contract (or domain/range contracts). original commit: 994ad6d10fc817a5ceca2f9f4874dac5c14c0aab
This commit is contained in:
parent
71d6d2f101
commit
7271481c49
|
@ -23,6 +23,13 @@
|
|||
(require "private/contract-define.rkt")
|
||||
(provide (all-from-out "private/contract-define.rkt"))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; old-style flat mutable contracts
|
||||
;;
|
||||
(require "private/contract-mutable.rkt")
|
||||
(provide (all-from-out "private/contract-mutable.rkt"))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;;
|
||||
;; provide everything from the racket/ implementation
|
||||
|
@ -30,8 +37,6 @@
|
|||
;;
|
||||
|
||||
(require racket/contract/private/base
|
||||
racket/contract/private/box
|
||||
racket/contract/private/hash
|
||||
racket/contract/private/misc
|
||||
racket/contract/private/provide
|
||||
racket/contract/private/guts
|
||||
|
@ -46,8 +51,6 @@
|
|||
contract-struct)
|
||||
|
||||
(all-from-out racket/contract/private/base)
|
||||
(all-from-out racket/contract/private/box)
|
||||
(all-from-out racket/contract/private/hash)
|
||||
(all-from-out racket/contract/private/provide)
|
||||
(except-out (all-from-out racket/contract/private/misc)
|
||||
check-between/c
|
||||
|
|
24
collects/mzlib/private/contract-mutable.rkt
Normal file
24
collects/mzlib/private/contract-mutable.rkt
Normal file
|
@ -0,0 +1,24 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (only-in racket/contract/private/box box-immutable/c)
|
||||
racket/contract/private/blame
|
||||
racket/contract/private/guts)
|
||||
|
||||
(provide box/c box-immutable/c)
|
||||
|
||||
(define/subexpression-pos-prop (box/c ctc)
|
||||
(let ([ctc (coerce-flat-contract 'box/c ctc)])
|
||||
(make-flat-contract
|
||||
#:name (build-compound-type-name 'box/c ctc)
|
||||
#:first-order
|
||||
(λ (val)
|
||||
(and (box? val)
|
||||
(contract-first-order-passes? ctc (unbox val))))
|
||||
#:projection
|
||||
(λ (blame)
|
||||
(λ (val)
|
||||
(let ([proj ((contract-projection ctc) blame)])
|
||||
(unless (box? val)
|
||||
(raise-blame-error blame val "not a box"))
|
||||
(proj (unbox val))
|
||||
val))))))
|
Loading…
Reference in New Issue
Block a user