Separated prop:dict from gen:dict.
This work is in preparation for widening the interface of gen:dict with operations like dict-for-each, dict-update, etc., each with a fallback implementation. The property prop:dict, with its documented, fixed-length vector representation, cannot be extended, whereas a generic with optional methods can be.
This commit is contained in:
Carl Eastlund
parent
f7f15e1113
commit
7deb4ad025
|
|
@ -1,11 +1,227 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/private/generic ; to avoid circular dependencies
|
||||
racket/private/generic-methods
|
||||
(for-syntax racket/base))
|
||||
|
||||
(define (assoc? v)
|
||||
(and (list? v) (andmap pair? v)))
|
||||
|
||||
(define (immutable-hash? v)
|
||||
(and (hash? v) (immutable? v)))
|
||||
|
||||
(define (mutable-hash? v)
|
||||
(and (hash? v) (not (immutable? v))))
|
||||
|
||||
(define (immutable-vector? v)
|
||||
(and (vector? v) (immutable? v)))
|
||||
|
||||
(define (mutable-vector? v)
|
||||
(and (vector? v) (not (immutable? v))))
|
||||
|
||||
(define (dict-supports? who d . whats)
|
||||
(unless (dict? d)
|
||||
(raise-argument-error who "dict?" d))
|
||||
(define table (dict-def-table d))
|
||||
(for/or ([what (in-list whats)])
|
||||
(hash-ref table what #f)))
|
||||
|
||||
(define (dict-mutable? d)
|
||||
(dict-supports? 'dict-mutable? d 'dict-set!))
|
||||
|
||||
(define (dict-can-remove-keys? d)
|
||||
(dict-supports? 'dict-can-remove-keys? d 'dict-remove! 'dict-remove))
|
||||
|
||||
(define (dict-can-functional-set? d)
|
||||
(dict-supports? 'dict-can-functional-set? d 'dict-set))
|
||||
|
||||
(define (dict-has-key? d k)
|
||||
(define not-there (gensym))
|
||||
(not (eq? not-there (dict-ref d k not-there))))
|
||||
|
||||
(define vector-ref-as-dict
|
||||
(case-lambda
|
||||
[(d key) (vector-ref d key)]
|
||||
[(d key default)
|
||||
(if (and (exact-nonnegative-integer? key)
|
||||
(key . < . (vector-length d)))
|
||||
(vector-ref d key)
|
||||
(if (procedure? default)
|
||||
(default)
|
||||
default))]))
|
||||
|
||||
(define no-arg (gensym))
|
||||
(define (assoc-ref d key [default no-arg])
|
||||
(cond
|
||||
[(assoc key d) => cdr]
|
||||
[(eq? default no-arg)
|
||||
(raise-mismatch-error 'dict-ref
|
||||
(format "no value for key: ~e in: " key)
|
||||
d)]
|
||||
[(procedure? default) (default)]
|
||||
[else default]))
|
||||
|
||||
(define (dict-ref! d key new)
|
||||
(define not-there (gensym))
|
||||
(define v (dict-ref d key not-there))
|
||||
(if (eq? not-there v)
|
||||
(let ([n (if (procedure? new) (new) new)])
|
||||
(dict-set! d key n)
|
||||
n)
|
||||
v))
|
||||
|
||||
(define (dict-set*! d . pairs)
|
||||
(unless (even? (length pairs))
|
||||
(error 'dict-set*! "expected an even number of association elements, but received an odd number: ~e" pairs))
|
||||
(let loop ([pairs pairs])
|
||||
(unless (null? pairs)
|
||||
(dict-set! d (car pairs) (cadr pairs))
|
||||
(loop (cddr pairs)))))
|
||||
|
||||
(define (assoc-set d key val)
|
||||
(let loop ([xd d])
|
||||
(cond
|
||||
[(null? xd) (list (cons key val))]
|
||||
[else
|
||||
(let ([a (car xd)])
|
||||
(if (equal? (car a) key)
|
||||
(cons (cons key val) (cdr xd))
|
||||
(cons a (loop (cdr xd)))))])))
|
||||
|
||||
(define (dict-set* d . pairs)
|
||||
(unless (even? (length pairs))
|
||||
(error 'dict-set* "expected an even number of association elements, but received an odd number: ~e" pairs))
|
||||
(let loop ([d d]
|
||||
[pairs pairs])
|
||||
(if (null? pairs)
|
||||
d
|
||||
(loop (dict-set d (car pairs) (cadr pairs))
|
||||
(cddr pairs)))))
|
||||
|
||||
(define dict-update!
|
||||
(case-lambda
|
||||
[(d key xform)
|
||||
(dict-set! d key (xform (dict-ref d key)))]
|
||||
[(d key xform default)
|
||||
(dict-set! d key (xform (dict-ref d key default)))]))
|
||||
|
||||
(define dict-update
|
||||
(case-lambda
|
||||
[(d key xform)
|
||||
(dict-set d key (xform (dict-ref d key)))]
|
||||
[(d key xform default)
|
||||
(dict-set d key (xform (dict-ref d key default)))]))
|
||||
|
||||
(define (assoc-remove d key)
|
||||
(let loop ([xd d])
|
||||
(cond
|
||||
[(null? xd) null]
|
||||
[else
|
||||
(let ([a (car xd)])
|
||||
(if (equal? (car a) key)
|
||||
(cdr xd)
|
||||
(cons a (loop (cdr xd)))))])))
|
||||
|
||||
(define (vector-iterate-first d)
|
||||
(if (zero? (vector-length d)) #f 0))
|
||||
|
||||
(define (vector-iterate-next d i)
|
||||
(let ([len (vector-length d)])
|
||||
(cond
|
||||
[(and (exact-nonnegative-integer? i)
|
||||
(i . < . len))
|
||||
(let ([i (add1 i)])
|
||||
(if (= i len)
|
||||
#f
|
||||
i))]
|
||||
[else
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-next
|
||||
"invalid iteration position for vector: "
|
||||
i)])))
|
||||
|
||||
(define (vector-iterate-key d i) i)
|
||||
|
||||
(define vector-iterate-value vector-ref)
|
||||
|
||||
(struct assoc-iter (head pos))
|
||||
|
||||
(define (assoc-iterate-first d)
|
||||
(if (null? d) #f (assoc-iter d d)))
|
||||
|
||||
(define (assoc-iterate-next d i)
|
||||
(if (and (assoc-iter? i)
|
||||
(eq? d (assoc-iter-head i)))
|
||||
(let ([pos (cdr (assoc-iter-pos i))])
|
||||
(if (null? pos)
|
||||
#f
|
||||
(assoc-iter d pos)))
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-next
|
||||
"invalid iteration position for association list: "
|
||||
i)))
|
||||
|
||||
(define (assoc-iterate-key d i)
|
||||
(if (and (assoc-iter? i) (eq? d (assoc-iter-head i)))
|
||||
(caar (assoc-iter-pos i))
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-key
|
||||
"invalid iteration position for association list: "
|
||||
i)))
|
||||
|
||||
(define (assoc-iterate-value d i)
|
||||
(if (and (assoc-iter? i) (eq? d (assoc-iter-head i)))
|
||||
(cdar (assoc-iter-pos i))
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-value
|
||||
"invalid iteration position for association list: "
|
||||
i)))
|
||||
|
||||
(define-primitive-generics
|
||||
(dict gen:dict prop:dict dict-methods dict? dict-def-table)
|
||||
#:defaults ()
|
||||
(dict gen:dict prop:gen:dict prop:gen:dict-methods dict? dict-def-table)
|
||||
#:defaults
|
||||
([mutable-hash?
|
||||
(define dict-ref hash-ref)
|
||||
(define dict-set! hash-set!)
|
||||
(define dict-remove! hash-remove!)
|
||||
(define dict-count hash-count)
|
||||
(define dict-iterate-first hash-iterate-first)
|
||||
(define dict-iterate-next hash-iterate-next)
|
||||
(define dict-iterate-key hash-iterate-key)
|
||||
(define dict-iterate-value hash-iterate-value)]
|
||||
[immutable-hash?
|
||||
(define dict-ref hash-ref)
|
||||
(define dict-set hash-set)
|
||||
(define dict-remove hash-remove)
|
||||
(define dict-count hash-count)
|
||||
(define dict-iterate-first hash-iterate-first)
|
||||
(define dict-iterate-next hash-iterate-next)
|
||||
(define dict-iterate-key hash-iterate-key)
|
||||
(define dict-iterate-value hash-iterate-value)]
|
||||
[mutable-vector?
|
||||
(define dict-ref vector-ref-as-dict)
|
||||
(define dict-set! vector-set!)
|
||||
(define dict-count vector-length)
|
||||
(define dict-iterate-first vector-iterate-first)
|
||||
(define dict-iterate-next vector-iterate-next)
|
||||
(define dict-iterate-key vector-iterate-key)
|
||||
(define dict-iterate-value vector-iterate-value)]
|
||||
[immutable-vector?
|
||||
(define dict-ref vector-ref-as-dict)
|
||||
(define dict-count vector-length)
|
||||
(define dict-iterate-first vector-iterate-first)
|
||||
(define dict-iterate-next vector-iterate-next)
|
||||
(define dict-iterate-key vector-iterate-key)
|
||||
(define dict-iterate-value vector-iterate-value)]
|
||||
[assoc?
|
||||
(define dict-ref assoc-ref)
|
||||
(define dict-set assoc-set)
|
||||
(define dict-remove assoc-remove)
|
||||
(define dict-count length)
|
||||
(define dict-iterate-first assoc-iterate-first)
|
||||
(define dict-iterate-next assoc-iterate-next)
|
||||
(define dict-iterate-key assoc-iterate-key)
|
||||
(define dict-iterate-value assoc-iterate-value)])
|
||||
#:fallbacks ()
|
||||
#:derive-properties ()
|
||||
(dict-ref dict key [default])
|
||||
|
|
@ -19,280 +235,64 @@
|
|||
(dict-iterate-key dict pos)
|
||||
(dict-iterate-value dict pos))
|
||||
|
||||
(define (assoc? v)
|
||||
(and (list? v) (andmap pair? v)))
|
||||
(define (check-method who v i req? name arity [alt #f])
|
||||
(define m (vector-ref v i))
|
||||
(unless (or (and (not req?) (not m))
|
||||
(and (procedure? m)
|
||||
(procedure-arity-includes? m arity)
|
||||
(or (not alt)
|
||||
(procedure-arity-includes? m alt))))
|
||||
(raise-arguments-error
|
||||
who
|
||||
(format
|
||||
"method at index ~a (~a) must be~a a procedure that accepts ~a ~a~a"
|
||||
i
|
||||
name
|
||||
(if req? "" " #f or")
|
||||
arity
|
||||
(if (= 1 arity) "argument" "arguments")
|
||||
(if alt
|
||||
(format " and ~a ~a"
|
||||
alt
|
||||
(if (= 1 alt) "argument" "arguments"))
|
||||
""))
|
||||
name
|
||||
m)))
|
||||
|
||||
(define (d:dict? v)
|
||||
(or (hash? v)
|
||||
(vector? v)
|
||||
(assoc? v)
|
||||
(dict? v)))
|
||||
(define (guard-for-prop:dict v info)
|
||||
(unless (and (vector? v) (= (vector-length v) 10))
|
||||
(raise-argument-error 'guard-for-prop:dict "a vector of length 10" v))
|
||||
(check-method 'guard-for-prop:dict v 0 #t "dict-ref" 2 3)
|
||||
(check-method 'guard-for-prop:dict v 1 #f "dict-set!" 3)
|
||||
(check-method 'guard-for-prop:dict v 2 #f "dict-set" 3)
|
||||
(check-method 'guard-for-prop:dict v 3 #f "dict-remove!" 2)
|
||||
(check-method 'guard-for-prop:dict v 4 #f "dict-remove" 2)
|
||||
(check-method 'guard-for-prop:dict v 5 #t "dict-count" 1)
|
||||
(check-method 'guard-for-prop:dict v 6 #t "dict-iterate-first" 1)
|
||||
(check-method 'guard-for-prop:dict v 7 #t "dict-iterate-next" 2)
|
||||
(check-method 'guard-for-prop:dict v 8 #t "dict-iterate-key" 2)
|
||||
(check-method 'guard-for-prop:dict v 9 #t "dict-iterate-value" 2)
|
||||
v)
|
||||
|
||||
(define (dict-mutable? d)
|
||||
(if (d:dict? d)
|
||||
(or (and (or (hash? d)
|
||||
(vector? d))
|
||||
(not (immutable? d)))
|
||||
(and (dict? d)
|
||||
(hash-ref (dict-def-table d) 'dict-set! #f)
|
||||
#t))
|
||||
(raise-argument-error 'dict-mutable? "dict?" d)))
|
||||
(define (prop:dict->gen:dict v)
|
||||
(generic-method-table gen:dict
|
||||
(define dict-ref (vector-ref v 0))
|
||||
(define dict-set! (vector-ref v 1))
|
||||
(define dict-set (vector-ref v 2))
|
||||
(define dict-remove! (vector-ref v 3))
|
||||
(define dict-remove (vector-ref v 4))
|
||||
(define dict-count (vector-ref v 5))
|
||||
(define dict-iterate-first (vector-ref v 6))
|
||||
(define dict-iterate-next (vector-ref v 7))
|
||||
(define dict-iterate-key (vector-ref v 8))
|
||||
(define dict-iterate-value (vector-ref v 9))))
|
||||
|
||||
(define (dict-can-remove-keys? d)
|
||||
(if (d:dict? d)
|
||||
(or (hash? d)
|
||||
(assoc? d)
|
||||
(and (dict? d)
|
||||
(or (hash-ref (dict-def-table d) 'dict-remove! #f)
|
||||
(hash-ref (dict-def-table d) 'dict-remove #f))
|
||||
#t))
|
||||
(raise-argument-error 'dict-can-remove-keys? "dict?" d)))
|
||||
|
||||
(define (dict-can-functional-set? d)
|
||||
(if (d:dict? d)
|
||||
(or (and (hash? d) (immutable? d))
|
||||
(assoc? d)
|
||||
(and (dict? d)
|
||||
(hash-ref (dict-def-table d) 'dict-set #f)
|
||||
#t))
|
||||
(raise-argument-error 'dict-can-functional-set? "dict?" d)))
|
||||
|
||||
(define (dict-has-key? d k)
|
||||
(define not-there (gensym))
|
||||
(not (eq? not-there (d:dict-ref d k not-there))))
|
||||
|
||||
(define d:dict-ref
|
||||
(case-lambda
|
||||
[(d key)
|
||||
(cond
|
||||
[(hash? d) (hash-ref d key)]
|
||||
[(vector? d) (vector-ref d key)]
|
||||
[(assoc? d)
|
||||
(let ([a (assoc key d)])
|
||||
(if a
|
||||
(cdr a)
|
||||
(raise-mismatch-error 'dict-ref
|
||||
(format "no value for key: ~e in: "
|
||||
key)
|
||||
d)))]
|
||||
[(dict? d) (dict-ref d key)]
|
||||
[else
|
||||
(raise-argument-error 'dict-ref "dict?" 0 d key)])]
|
||||
[(d key default)
|
||||
(cond
|
||||
[(hash? d) (hash-ref d key default)]
|
||||
[(vector? d) (if (and (exact-nonnegative-integer? key)
|
||||
(key . < . (vector-length d)))
|
||||
(vector-ref d key)
|
||||
(if (procedure? default)
|
||||
(default)
|
||||
default))]
|
||||
[(assoc? d)
|
||||
(let ([a (assoc key d)])
|
||||
(if a
|
||||
(cdr a)
|
||||
(if (procedure? default)
|
||||
(default)
|
||||
default)))]
|
||||
[(dict? d)
|
||||
(dict-ref d key default)]
|
||||
[else
|
||||
(raise-argument-error 'dict-ref "dict?" 0 d key default)])]))
|
||||
|
||||
(define (dict-ref! d key new)
|
||||
(define not-there (gensym))
|
||||
(define v (d:dict-ref d key not-there))
|
||||
(if (eq? not-there v)
|
||||
(let ([n (if (procedure? new) (new) new)])
|
||||
(d:dict-set! d key n)
|
||||
n)
|
||||
v))
|
||||
|
||||
(define (d:dict-set! d key val)
|
||||
(cond
|
||||
[(hash? d) (hash-set! d key val)]
|
||||
[(vector? d) (vector-set! d key val)]
|
||||
[(assoc? d)
|
||||
(raise-argument-error 'dict-set! "mutable-dict?" 0 d key val)]
|
||||
[(dict? d)
|
||||
(let ([s! (hash-ref (dict-def-table d) 'dict-set! #f)])
|
||||
(if s!
|
||||
(dict-set! d key val)
|
||||
(raise-argument-error 'dict-set! "mutable-dict?" 0 d key val)))]
|
||||
[else
|
||||
(raise-argument-error 'dict-set! "dict?" 0 d key val)]))
|
||||
|
||||
(define (dict-set*! d . pairs)
|
||||
(unless (even? (length pairs))
|
||||
(error 'dict-set*! "expected an even number of association elements, but received an odd number: ~e" pairs))
|
||||
(let loop ([pairs pairs])
|
||||
(unless (null? pairs)
|
||||
(d:dict-set! d (car pairs) (cadr pairs))
|
||||
(loop (cddr pairs)))))
|
||||
|
||||
(define (d:dict-set d key val)
|
||||
(cond
|
||||
[(hash? d) (hash-set d key val)]
|
||||
[(vector? d)
|
||||
(raise-argument-error 'dict-set "functional-update-dict?" 0 d key val)]
|
||||
[(assoc? d)
|
||||
(let loop ([xd d])
|
||||
(cond
|
||||
[(null? xd) (list (cons key val))]
|
||||
[else
|
||||
(let ([a (car xd)])
|
||||
(if (equal? (car a) key)
|
||||
(cons (cons key val) (cdr xd))
|
||||
(cons a (loop (cdr xd)))))]))]
|
||||
[(dict? d)
|
||||
(let ([s (hash-ref (dict-def-table d) 'dict-set #f)])
|
||||
(if s
|
||||
(dict-set d key val)
|
||||
(raise-argument-error 'dict-set "functional-update-dict?" 0 d key val)))]
|
||||
[else
|
||||
(raise-argument-error 'dict-set "dict?" 0 d key val)]))
|
||||
|
||||
(define (dict-set* d . pairs)
|
||||
(unless (even? (length pairs))
|
||||
(error 'dict-set* "expected an even number of association elements, but received an odd number: ~e" pairs))
|
||||
(let loop ([d d]
|
||||
[pairs pairs])
|
||||
(if (null? pairs)
|
||||
d
|
||||
(loop (d:dict-set d (car pairs) (cadr pairs))
|
||||
(cddr pairs)))))
|
||||
|
||||
(define dict-update!
|
||||
(case-lambda
|
||||
[(d key xform)
|
||||
(d:dict-set! d key (xform (d:dict-ref d key)))]
|
||||
[(d key xform default)
|
||||
(d:dict-set! d key (xform (d:dict-ref d key default)))]))
|
||||
|
||||
(define dict-update
|
||||
(case-lambda
|
||||
[(d key xform)
|
||||
(d:dict-set d key (xform (d:dict-ref d key)))]
|
||||
[(d key xform default)
|
||||
(d:dict-set d key (xform (d:dict-ref d key default)))]))
|
||||
|
||||
(define (d:dict-remove! d key)
|
||||
(cond
|
||||
[(hash? d) (hash-remove! d key)]
|
||||
[(vector? d)
|
||||
(raise-argument-error 'dict-remove! "dict-with-removeable-keys?" 0 d key)]
|
||||
[(assoc? d)
|
||||
(raise-argument-error 'dict-remove! "mutable-dict?" 0 d key)]
|
||||
[(dict? d)
|
||||
(let ([r! (hash-ref (dict-def-table d) 'dict-remove! #f)])
|
||||
(if r!
|
||||
(dict-remove! d key)
|
||||
(raise-argument-error 'dict-remove! "mutable-dict-with-removable-keys?" 0 d key)))]
|
||||
[else
|
||||
(raise-argument-error 'dict-remove! "dict?" 0 d key)]))
|
||||
|
||||
(define (d:dict-remove d key)
|
||||
(cond
|
||||
[(hash? d) (hash-remove d key)]
|
||||
[(vector? d)
|
||||
(raise-argument-error 'dict-remove "dict-with-removeable-keys?" 0 d key)]
|
||||
[(assoc? d)
|
||||
(let loop ([xd d])
|
||||
(cond
|
||||
[(null? xd) null]
|
||||
[else
|
||||
(let ([a (car xd)])
|
||||
(if (equal? (car a) key)
|
||||
(cdr xd)
|
||||
(cons a (loop (cdr xd)))))]))]
|
||||
[(dict? d)
|
||||
(let ([s (hash-ref (dict-def-table d) 'dict-remove #f)])
|
||||
(if s
|
||||
(dict-remove d key)
|
||||
(raise-argument-error 'dict-remove "dict-with-functionally-removeable-keys?" 0 d key)))]
|
||||
[else
|
||||
(raise-argument-error 'dict-remove "dict?" 0 d key)]))
|
||||
|
||||
(define (d:dict-count d)
|
||||
(cond
|
||||
[(hash? d) (hash-count d)]
|
||||
[(vector? d) (vector-length d)]
|
||||
[(assoc? d) (length d)]
|
||||
[(dict? d) (dict-count d)]
|
||||
[else
|
||||
(raise-argument-error 'dict-count "dict?" d)]))
|
||||
|
||||
(struct assoc-iter (head pos))
|
||||
|
||||
(define (d:dict-iterate-first d)
|
||||
(cond
|
||||
[(hash? d) (hash-iterate-first d)]
|
||||
[(vector? d) (if (zero? (vector-length d))
|
||||
#f
|
||||
0)]
|
||||
[(assoc? d) (if (null? d) #f (assoc-iter d d))]
|
||||
[(dict? d) (dict-iterate-first d)]
|
||||
[else
|
||||
(raise-argument-error 'dict-iterate-first "dict?" d)]))
|
||||
|
||||
(define (d:dict-iterate-next d i)
|
||||
(cond
|
||||
[(hash? d) (hash-iterate-next d i)]
|
||||
[(vector? d) (let ([len (vector-length d)])
|
||||
(cond
|
||||
[(and (exact-nonnegative-integer? i)
|
||||
(i . < . len))
|
||||
(let ([i (add1 i)])
|
||||
(if (= i len)
|
||||
#f
|
||||
i))]
|
||||
[else
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-next
|
||||
"invalid iteration position for vector: "
|
||||
i)]))]
|
||||
[(and (assoc-iter? i)
|
||||
(eq? d (assoc-iter-head i)))
|
||||
(let ([pos (cdr (assoc-iter-pos i))])
|
||||
(if (null? pos)
|
||||
#f
|
||||
(assoc-iter d pos)))]
|
||||
[(dict? d) (dict-iterate-next d i)]
|
||||
[(assoc? d)
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-next
|
||||
"invalid iteration position for association list: "
|
||||
i)]
|
||||
[else
|
||||
(raise-argument-error 'dict-iterate-next "dict?" d)]))
|
||||
|
||||
(define (d:dict-iterate-key d i)
|
||||
(cond
|
||||
[(hash? d) (hash-iterate-key d i)]
|
||||
[(vector? d) i]
|
||||
[(and (assoc-iter? i) (eq? d (assoc-iter-head i))) (caar (assoc-iter-pos i))]
|
||||
[(dict? d) (dict-iterate-key d i)]
|
||||
[(assoc? d)
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-key
|
||||
"invalid iteration position for association list: "
|
||||
i)]
|
||||
[else
|
||||
(raise-argument-error 'dict-iterate-key "dict?" d)]))
|
||||
|
||||
(define (d:dict-iterate-value d i)
|
||||
(cond
|
||||
[(hash? d) (hash-iterate-value d i)]
|
||||
[(vector? d) (vector-ref d i)]
|
||||
[(and (assoc-iter? i) (eq? d (assoc-iter-head i))) (cdar (assoc-iter-pos i))]
|
||||
[(dict? d) (dict-iterate-value d i)]
|
||||
[(assoc? d)
|
||||
(raise-mismatch-error
|
||||
'dict-iterate-value
|
||||
"invalid iteration position for association list: "
|
||||
i)]
|
||||
[else
|
||||
(raise-argument-error 'dict-iterate-value "dict?" d)]))
|
||||
(define-values (prop:dict dict-via-prop? prop:dict-methods)
|
||||
(make-struct-type-property
|
||||
'dict
|
||||
guard-for-prop:dict
|
||||
(list (cons prop:gen:dict prop:dict->gen:dict))
|
||||
#t))
|
||||
|
||||
(define-sequence-syntax :in-dict
|
||||
(lambda () #'in-dict)
|
||||
|
|
@ -301,15 +301,15 @@
|
|||
[((key-id val-id) (_ dict-expr))
|
||||
#'[(key-id val-id)
|
||||
(:do-in ([(d) dict-expr])
|
||||
(unless (d:dict? d)
|
||||
(unless (dict? d)
|
||||
(raise-argument-error 'in-dict "dict?" d))
|
||||
([i (d:dict-iterate-first d)])
|
||||
([i (dict-iterate-first d)])
|
||||
i
|
||||
([(key-id) (d:dict-iterate-key d i)]
|
||||
[(val-id) (d:dict-iterate-value d i)])
|
||||
([(key-id) (dict-iterate-key d i)]
|
||||
[(val-id) (dict-iterate-value d i)])
|
||||
#t
|
||||
#t
|
||||
((d:dict-iterate-next d i)))]]
|
||||
((dict-iterate-next d i)))]]
|
||||
[_ #f])))
|
||||
|
||||
(define-sequence-syntax :in-dict-keys
|
||||
|
|
@ -319,14 +319,14 @@
|
|||
[((key-id) (_ dict-expr))
|
||||
#'[(key-id)
|
||||
(:do-in ([(d) dict-expr])
|
||||
(unless (d:dict? d)
|
||||
(unless (dict? d)
|
||||
(raise-argument-error 'in-dict-keys "dict?" d))
|
||||
([i (d:dict-iterate-first d)])
|
||||
([i (dict-iterate-first d)])
|
||||
i
|
||||
([(key-id) (d:dict-iterate-key d i)])
|
||||
([(key-id) (dict-iterate-key d i)])
|
||||
#t
|
||||
#t
|
||||
((d:dict-iterate-next d i)))]]
|
||||
((dict-iterate-next d i)))]]
|
||||
[_ #f])))
|
||||
|
||||
(define-sequence-syntax :in-dict-values
|
||||
|
|
@ -336,36 +336,36 @@
|
|||
[((val-id) (_ dict-expr))
|
||||
#'[(key-id val-id)
|
||||
(:do-in ([(d) dict-expr])
|
||||
(unless (d:dict? d)
|
||||
(unless (dict? d)
|
||||
(raise-argument-error 'in-dict-values "dict?" d))
|
||||
([i (d:dict-iterate-first d)])
|
||||
([i (dict-iterate-first d)])
|
||||
i
|
||||
([(val-id) (d:dict-iterate-value d i)])
|
||||
([(val-id) (dict-iterate-value d i)])
|
||||
#t
|
||||
#t
|
||||
((d:dict-iterate-next d i)))]]
|
||||
((dict-iterate-next d i)))]]
|
||||
[_ #f])))
|
||||
|
||||
(define (in-dict d)
|
||||
(make-dict-sequence
|
||||
d
|
||||
(lambda (i)
|
||||
(values (d:dict-iterate-key d i)
|
||||
(d:dict-iterate-value d i)))
|
||||
(values (dict-iterate-key d i)
|
||||
(dict-iterate-value d i)))
|
||||
(lambda (k v) #t)
|
||||
(lambda (i k v) #t)))
|
||||
|
||||
(define (in-dict-keys d)
|
||||
(make-dict-sequence
|
||||
d
|
||||
(lambda (i) (d:dict-iterate-key d i))
|
||||
(lambda (i) (dict-iterate-key d i))
|
||||
(lambda (k) #t)
|
||||
(lambda (i k) #t)))
|
||||
|
||||
(define (in-dict-values d)
|
||||
(make-dict-sequence
|
||||
d
|
||||
(lambda (i) (d:dict-iterate-value d i))
|
||||
(lambda (i) (dict-iterate-value d i))
|
||||
(lambda (v) #t)
|
||||
(lambda (i v) #t)))
|
||||
|
||||
|
|
@ -373,8 +373,8 @@
|
|||
(make-dict-sequence
|
||||
d
|
||||
(lambda (i)
|
||||
(cons (d:dict-iterate-key d i)
|
||||
(d:dict-iterate-value d i)))
|
||||
(cons (dict-iterate-key d i)
|
||||
(dict-iterate-value d i)))
|
||||
(lambda (p) #t)
|
||||
(lambda (i p) #t)))
|
||||
|
||||
|
|
@ -382,8 +382,8 @@
|
|||
(make-do-sequence
|
||||
(lambda ()
|
||||
(values get
|
||||
(lambda (i) (d:dict-iterate-next d i))
|
||||
(d:dict-iterate-first d)
|
||||
(lambda (i) (dict-iterate-next d i))
|
||||
(dict-iterate-first d)
|
||||
(lambda (i) i)
|
||||
val-true
|
||||
val+pos-true))))
|
||||
|
|
@ -544,18 +544,17 @@
|
|||
|
||||
(provide gen:dict
|
||||
prop:dict
|
||||
(rename-out
|
||||
[d:dict? dict?]
|
||||
[d:dict-ref dict-ref]
|
||||
[d:dict-set! dict-set!]
|
||||
[d:dict-set dict-set]
|
||||
[d:dict-remove! dict-remove!]
|
||||
[d:dict-remove dict-remove]
|
||||
[d:dict-count dict-count]
|
||||
[d:dict-iterate-first dict-iterate-first]
|
||||
[d:dict-iterate-next dict-iterate-next]
|
||||
[d:dict-iterate-key dict-iterate-key]
|
||||
[d:dict-iterate-value dict-iterate-value])
|
||||
dict?
|
||||
dict-ref
|
||||
dict-set!
|
||||
dict-set
|
||||
dict-remove!
|
||||
dict-remove
|
||||
dict-count
|
||||
dict-iterate-first
|
||||
dict-iterate-next
|
||||
dict-iterate-key
|
||||
dict-iterate-value
|
||||
dict-mutable?
|
||||
dict-can-remove-keys?
|
||||
dict-can-functional-set?
|
||||
|
|
|
|||
|
|
@ -149,7 +149,10 @@
|
|||
#'(define (supported-name self-name)
|
||||
(define v table)
|
||||
(make-immutable-hasheqv
|
||||
(list (cons 'method-name (vector-ref v 'index)) ...))))]))
|
||||
(list
|
||||
(cons 'method-name
|
||||
(procedure? (vector-ref v 'index)))
|
||||
...))))]))
|
||||
|
||||
(begin-for-syntax
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user