cleanup names, add tests

This commit is contained in:
Ben Greenman 2017-10-06 16:00:50 -04:00
parent 6cffbfa6d8
commit a58fc276c9
4 changed files with 48 additions and 9 deletions

View File

@ -160,7 +160,7 @@
((vectorof/sc (#:invariant)) vectorof #:chaperone)
((promise/sc (#:covariant)) promise-not-name/c #:chaperone)
((syntax/sc (#:covariant #:flat)) syntax/c #:flat)
((hash/sc (#:invariant) (#:invariant)) tr-hash/c #:chaperone)
((hash/sc (#:invariant) (#:invariant)) typed-racket-hash/c #:chaperone)
((mutable-hash/sc (#:invariant) (#:invariant)) mutable-hash/c #:chaperone)
((immutable-hash/sc (#:covariant) (#:covariant)) immutable-hash/c #:flat)
((weak-hash/sc (#:invariant) (#:invariant)) weak-hash/c #:chaperone)

View File

@ -1,18 +1,28 @@
#lang racket/base
;; Typed Racket custom hashtable contracts.
;; Goals:
;; - implement contracts for mutable/immutable/weak hashtables
;; - give a better error message than `racket/contract` when user
;; tries to apply "a contract with a non-flat key"
;; to a "hashtable that doesn't compare keys with equal?"
(require racket/contract)
(provide tr-hash/c mutable-hash/c immutable-hash/c weak-hash/c)
(provide typed-racket-hash/c mutable-hash/c immutable-hash/c weak-hash/c)
(define (typed-racket-hash/c k v)
(and/c hash? (hash/c/check-key k v)))
(define (mutable-hash/c k v)
(and/c hash? (not/c hash-weak?) (tr-hash/c k v #:immutable #f)))
(and/c hash? (not/c hash-weak?) (hash/c/check-key k v #:immutable #f)))
(define (immutable-hash/c k v)
(tr-hash/c k v #:immutable #t))
(and/c hash? (hash/c/check-key k v #:immutable #t)))
(define (weak-hash/c k v)
(and/c hash? hash-weak? (tr-hash/c k v #:immutable #f)))
(and/c hash? hash-weak? (hash/c/check-key k v #:immutable #f)))
(define (tr-hash/c k v #:immutable [immutable 'dont-care])
(if (flat-contract? k)
(hash/c k v #:immutable immutable)
(and/c hash? hash-equal? (hash/c k v #:immutable immutable))))
(define (hash/c/check-key k v #:immutable [immutable 'dont-care])
;; TODO if (flat-contract? k), then make a contract that produces a "good"
;; error message given a hashtable that is not a `hash-equal?`
(hash/c k v #:immutable immutable))

View File

@ -0,0 +1,23 @@
#lang racket/base
;; Hash contracts with non-flat keys should give a good error messages
;; when applied to hashes that are not `hash-equal?`
(module t typed/racket/base
(provide give-me-a-hash)
(: give-me-a-hash (-> (HashTable (Vectorof Symbol) Symbol) Symbol))
(define (give-me-a-hash x)
'thanks))
(require 't rackunit)
(define err-regexp #rx"expected equal\\?-based hash")
(check-exn err-regexp
(λ () (give-me-a-hash (hasheqv))))
(check-exn err-regexp
(λ () (give-me-a-hash (hasheq))))
(check-not-exn
(λ () (give-me-a-hash (hash))))

View File

@ -70,6 +70,12 @@
(t/sc (-mu sexp (Un -Null -Symbol (-pair sexp sexp) (-vec sexp) (-box sexp))))
(t/sc (-mu a (-> a a)))
(t/sc (-seq -Symbol))
;; HashTables with non-flat keys and values (Issue 625)
;; https://github.com/racket/typed-racket/issues/625
(t/sc (-Mutable-HT (-vec -Symbol) (-vec -Symbol)))
(t/sc (-Immutable-HT (-vec -Symbol) (-vec -Symbol)))
(t/sc (-Weak-HT (-vec -Symbol) (-vec -Symbol)))
(t/sc (-HT (-vec -Symbol) (-vec -Symbol)))
;; These tests for unit static contracts are insufficient, but
;; in order to test Unit types the signature environment must be
;; set up correctly. More complex cases of compilation to unit/c