[plt-dev] Re: [plt] Push #20296: master branch updated

Does this go into the release?


On May 22, cce at racket-lang.org wrote:
> cce has updated `master' from f5a0b9e613 to 5d6afabf5e.
>   http://git.racket-lang.org/plt/f5a0b9e613..5d6afabf5e
> 
> =====[ 1 Commits ]======================================================
> 
> 5d6afab Carl Eastlund <cce at racket-lang.org> 2010-05-20 15:56
> :
> | Improved error messages for misuse of prop:dict.
> :
>   M collects/racket/dict.rkt |  128 ++++++++++++++++++++++++++++++-------------
> 
> =====[ Overall Diff ]===================================================
> 
> collects/racket/dict.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/collects/racket/dict.rkt
> +++ NEW/collects/racket/dict.rkt
> @@ -34,45 +34,97 @@
>                       [create-immutable-custom-hash make-immutable-custom-hash])
>           make-weak-custom-hash)
>  
> +(define (dict-property-guard v info)
> +  (check-dict-vector 'prop:dict "dictionary property" v)
> +  v)
> +
> +(define (check-dict-vector caller desc v)
> +  (check-vector*
> +   caller desc v
> +   (list check-dict-ref
> +         check-dict-set!
> +         check-dict-set
> +         check-dict-remove
> +         check-dict-remove!
> +         check-dict-count
> +         check-dict-iterate-first
> +         check-dict-iterate-next
> +         check-dict-iterate-key
> +         check-dict-iterate-value)))
> +
> +(define (check-vector* caller desc v checkers)
> +  (unless (vector? v)
> +    (contract-error
> +     "~a: expected ~a to be a vector, but got: ~e"
> +     caller desc v))
> +  (let* ([expected (length checkers)]
> +         [actual (vector-length v)])
> +    (unless (= expected actual)
> +      (contract-error
> +       (string-append
> +        "~a: expected ~a to be a vector of ~a elements, "
> +        "but got ~a elements in: ~e")
> +       caller desc expected actual v)))
> +  (for ([elem (in-vector v)] [checker (in-list checkers)] [index (in-naturals)])
> +    (checker caller (format "element ~a of ~a" index desc) elem)))
> +
> +(define (check-dict-ref caller desc v)
> +  (check-function/arity caller (describe "ref" desc) v 2 3))
> +(define (check-dict-set! caller desc v)
> +  (check-optional-function/arity caller (describe "set!" desc) v 3))
> +(define (check-dict-set caller desc v)
> +  (check-optional-function/arity caller (describe "set" desc) v 3))
> +(define (check-dict-remove! caller desc v)
> +  (check-optional-function/arity caller (describe "remove!" desc) v 2))
> +(define (check-dict-remove caller desc v)
> +  (check-optional-function/arity caller (describe "remove" desc) v 2))
> +(define (check-dict-count caller desc v)
> +  (check-function/arity caller (describe "count" desc) v 1))
> +(define (check-dict-iterate-first caller desc v)
> +  (check-function/arity caller (describe "iterate-first" desc) v 1))
> +(define (check-dict-iterate-next caller desc v)
> +  (check-function/arity caller (describe "iterate-next" desc) v 2))
> +(define (check-dict-iterate-key caller desc v)
> +  (check-function/arity caller (describe "iterate-key" desc) v 2))
> +(define (check-dict-iterate-value caller desc v)
> +  (check-function/arity caller (describe "iterate-value" desc) v 2))
> +
> +(define (describe name desc)
> +  (format "~a (~a)" name desc))
> +
> +(define (check-function/arity caller desc v . arities)
> +  (unless (procedure? v)
> +    (contract-error
> +     "~a: expected ~a to be a function, but got: ~e"
> +     caller desc v))
> +  (for ([arity (in-list arities)])
> +    (unless (procedure-arity-includes? v arity)
> +      (contract-error
> +       "~a: expected ~a to be a function that accepts ~a arguments, but got: ~e"
> +       caller desc arity v))))
> +
> +(define (check-optional-function/arity caller desc v . arities)
> +  (when v
> +    (unless (procedure? v)
> +      (contract-error
> +       "~a: expected ~a to be a function or #f, but got: ~e"
> +       caller desc v))
> +    (for ([arity (in-list arities)])
> +      (unless (procedure-arity-includes? v arity)
> +        (contract-error
> +         (string-append
> +          "~a: expected ~a to be a function that accepts ~a arguments,"
> +          " but got: ~e")
> +         caller desc arity v)))))
> +
> +(define (contract-error fmt . args)
> +  (raise
> +   (make-exn:fail:contract
> +    (apply format fmt args)
> +    (current-continuation-marks))))
> +
>  (define-values (prop:dict dict-struct? dict-struct-ref)
> -  (make-struct-type-property 'dict
> -                             (lambda (v info)
> -                               (unless (and 
> -                                        (vector? v)
> -                                        (= 10 (vector-length v))
> -                                        (let-values ([(ref set! set remove! remove count
> -                                                           iterate-first iterate-next
> -                                                           iterate-key iterate-value)
> -                                                      (vector->values v)])
> -                                          (and (procedure? ref)
> -                                               (and (procedure-arity-includes? ref 2)
> -                                                    (procedure-arity-includes? ref 3))
> -                                               (or (not set!)
> -                                                   (and (procedure? set!)
> -                                                        (procedure-arity-includes? set! 3)))
> -                                               (or (not set)
> -                                                   (and (procedure? set)
> -                                                        (procedure-arity-includes? set 3)))
> -                                               (or (not remove!)
> -                                                   (and (procedure? remove!)
> -                                                        (procedure-arity-includes? remove! 2)))
> -                                               (or (not remove)
> -                                                   (and (procedure? remove)
> -                                                        (procedure-arity-includes? remove 2)))
> -                                               (procedure? count)
> -                                               (procedure-arity-includes? count 1)
> -                                               (procedure? iterate-first)
> -                                               (procedure-arity-includes? iterate-first 1)
> -                                               (procedure? iterate-next)
> -                                               (procedure-arity-includes? iterate-next 2)
> -                                               (procedure? iterate-key)
> -                                               (procedure-arity-includes? iterate-key 2)
> -                                               (procedure? iterate-value)
> -                                               (procedure-arity-includes? iterate-value 2))))
> -                                 (raise-type-error 'prop:dict-guard
> -                                                   "vector of dict methods"
> -                                                   v))
> -                               v)))
> +  (make-struct-type-property 'dict dict-property-guard))
>  
>  (define (get-dict-ref v)
>    (vector-ref v 0))

-- 
          ((lambda (x) (x x)) (lambda (x) (x x)))          Eli Barzilay:
                    http://barzilay.org/                   Maze is Life!