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

added contracts (->i) to racket/dict

Browse Source
This commit is contained in:
Ryan Culpepper 2010-09-09 17:29:34 -06:00
parent 3f15f5bc13
commit a3d1ff4e6c
2 changed files with 155 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

190
collects/racket/dict.rkt
View File

@ -1,46 +1,6 @@
#lang racket/base
(require (for-syntax racket/base))
(provide prop:dict
dict?
dict-mutable?
dict-can-remove-keys?
dict-can-functional-set?
dict-has-key?
dict-ref
dict-ref!
dict-set!
dict-set*!
dict-set
dict-set*
dict-update!
dict-update
dict-remove!
dict-remove
dict-count
dict-iterate-first
dict-iterate-next
dict-iterate-key
dict-iterate-value
dict-map
dict-for-each
in-dict
in-dict-keys
in-dict-values
in-dict-pairs
dict-keys
dict-values
dict->list
(rename-out [create-custom-hash make-custom-hash]
[create-immutable-custom-hash make-immutable-custom-hash])
make-weak-custom-hash)
(require (for-syntax racket/base)
racket/contract/base)
(define (dict-property-guard v info)
(check-dict-vector 'prop:dict "dictionary property" v)
@ -131,9 +91,23 @@
(apply format fmt args)
(current-continuation-marks))))
(define (dict/c-property-guard v _)
v)
(define (dict/contracts-property-guard v _)
v)
(define-values (prop:dict dict-struct? dict-struct-ref)
(make-struct-type-property 'dict dict-property-guard))
(define-values (prop:dict/c dict/c-struct? dict/c-struct-ref)
(make-struct-type-property 'dict/c dict/c-property-guard))
(define-values (prop:dict/contracts dict/contracts? dict/contracts-ref)
(make-struct-type-property 'dict/contracts dict/contracts-property-guard
(list (cons prop:dict car)
(cons prop:dict/c cadr))))
(define (get-dict-ref v)
(vector-ref v 0))
(define (get-dict-set! v)
@ -155,6 +129,19 @@
(define (get-dict-iterate-value v)
(vector-ref v 9))
(define (get-dict/c-type-key-c v)
(vector-ref v 0))
(define (get-dict/c-type-value-c v)
(vector-ref v 1))
(define (get-dict/c-type-iter-c v)
(vector-ref v 2))
(define (get-dict/c-inst-key-c v)
(vector-ref v 3))
(define (get-dict/c-inst-value-c v)
(vector-ref v 4))
(define (get-dict/c-inst-iter-c v)
(vector-ref v 5))
(define (assoc? v)
(and (list? v) (andmap pair? v)))
@ -510,7 +497,34 @@
(for/list ([k*v (in-dict-pairs d)])
k*v))
;; ----------------------------------------
(define (dict-key-contract d)
(if (dict/c-struct? d)
(let ([type-key-contract (get-dict/c-type-key-c d)]
[inst-key-contract (get-dict/c-inst-key-c d)])
(if inst-key-contract
(and/c type-key-contract (inst-key-contract d))
type-key-contract))
any/c))
(define (dict-value-contract d)
(if (dict/c-struct? d)
(let ([type-value-contract (get-dict/c-type-value-c d)]
[inst-value-contract (get-dict/c-inst-value-c d)])
(if inst-value-contract
(and/c type-value-contract (inst-value-contract d))
type-value-contract))
any/c))
(define (dict-iter-contract d)
(if (dict/c-struct? d)
(let ([type-iter-contract (get-dict/c-type-iter-c d)]
[inst-iter-contract (get-dict/c-inst-iter-c d)])
(if inst-iter-contract
(and/c type-iter-contract (inst-iter-contract d))
type-iter-contract))
any/c))
;; ----------------------------------------
@ -645,3 +659,95 @@
(values make-custom-hash
make-immutable-custom-hash
make-weak-custom-hash))))
;; --------------------
(provide prop:dict
prop:dict/contracts
dict?
dict-mutable?
dict-can-remove-keys?
dict-can-functional-set?)
(provide/contract
[dict-has-key?
(-> dict? any/c boolean?)]
[dict-ref
(->i ([d dict?] [k (d) (dict-key-contract d)])
([default any/c])
[_ (d) (dict-value-contract d)])] ;; or == default ?
[dict-ref!
(->i ([d dict-mutable?] [k (d) (dict-key-contract d)]
[default any/c]) ;; refine using if/c
[_ (d) (dict-value-contract d)])] ;; or == default ?
[dict-set!
(->i ([d dict-mutable?]
[k (d) (dict-key-contract d)]
[value (d) (dict-value-contract d)])
[_ void?])]
[dict-set
(->i ([d dict-can-functional-set?]
[k (d) (dict-key-contract d)]
[value (d) (dict-value-contract d)])
[_ dict?])]
[dict-set*! any/c] ;; FIXME!!!
[dict-set* any/c] ;; FIXME!!!
[dict-update!
(->i ([d dict-mutable?]
[k (d) (dict-key-contract d)]
[update (d) (-> (dict-value-contract d) (dict-value-contract d))])
[_ void?])]
[dict-update
(->i ([d dict-can-functional-set?]
[k (d) (dict-key-contract d)]
[update (d) (-> (dict-value-contract d) (dict-value-contract d))])
[_ dict?])]
[dict-remove!
(->i ([d (and/c dict-mutable? dict-can-remove-keys?)]
[k (d) (dict-key-contract d)])
[_ void?])]
[dict-remove
(->i ([d (and/c dict-can-functional-set? dict-can-remove-keys?)]
[k (d) (dict-key-contract d)])
[_ dict?])]
[dict-count
(-> dict? exact-nonnegative-integer?)]
[dict-iterate-first
(->i ([d dict?]) [_ (d) (or/c #f (dict-iter-contract d))])]
[dict-iterate-next
(->i ([d dict?] [iter (d) (dict-iter-contract d)])
[_ (d) (or/c #f (dict-iter-contract d))])]
[dict-iterate-key
(->i ([d dict?] [iter (d) (dict-iter-contract d)])
[_ (d) (dict-key-contract d)])]
[dict-iterate-value
(->i ([d dict?] [iter (d) (dict-iter-contract d)])
[_ (d) (dict-value-contract d)])]
[dict-map
(->i ([d dict?] [proc (d) (-> (dict-key-contract d) (dict-value-contract d) any)])
[_ list?])]
[dict-for-each
(->i ([d dict?] [proc (d) (-> (dict-key-contract d) (dict-value-contract d) any)])
[_ void?])]
[dict-keys
(->i ([d dict?])
[_ (d) (listof (dict-key-contract d))])]
[dict-values
(->i ([d dict?])
[_ (d) (listof (dict-value-contract d))])]
[dict->list
(->i ([d dict?])
[_ (d) (listof (cons/c (dict-key-contract d) (dict-value-contract d)))])])
(provide (rename-out [create-custom-hash make-custom-hash]
[create-immutable-custom-hash make-immutable-custom-hash])
make-weak-custom-hash
in-dict
in-dict-keys
in-dict-values
in-dict-pairs)

13
collects/unstable/dirs.rkt
View File

@ -3,8 +3,7 @@
;; Unstable library by: Carl Eastlund <cce@ccs.neu.edu>
;; intended for use in racket/contract, so don't try to add contracts!
(require racket/dict
setup/path-relativize
(require setup/path-relativize
setup/dirs
(only-in planet/config [CACHE-DIR find-planet-dir]))
@ -31,19 +30,21 @@
(error 'path->directory-relative-string
"expected a path or a string (first argument); got: ~e" path))
(unless (dict? dirs)
(unless (and (list? dirs) (andmap pair? dirs))
(error 'path->directory-relative-string
"expected a dictionary (#:dirs keyword argument); got: ~e" dirs))
"expected an association list (#:dirs keyword argument); got: ~e" dirs))
(let/ec return
(when (complete-path? path)
(for ([(find-dir dir-name) (in-dict dirs)])
(for ([dir-entry (in-list dirs)])
(define find-dir (car dir-entry))
(define dir-name (cdr dir-entry))
(unless (and (procedure? find-dir)
(procedure-arity-includes? find-dir 0))
(error 'path->directory-relative-string
"expected keys in dictionary to be thunks (~a); got: ~e"
"expected keys in association list to be thunks (~a); got: ~e"
"#:dirs keyword argument"
find-dir))