Rewrite tables.ss in terms of new functional maps.
Improve error messages with contract errors. svn: r9228
This commit is contained in:
parent
13b7f8c506
commit
589850b998
|
@ -1,40 +1,27 @@
|
|||
#lang scheme/base
|
||||
|
||||
(require mzlib/plt-match)
|
||||
|
||||
(provide (all-defined-out))
|
||||
|
||||
;; a table is represented by an association list, (cons key value)
|
||||
|
||||
;; alist->eq : alist -> table
|
||||
(define (alist->eq l) l)
|
||||
(define (alist->eq l)
|
||||
(for/hasheq ([e l])
|
||||
(values (car e) (cdr e))))
|
||||
|
||||
;; to-sexp : table -> Listof(List k v)
|
||||
(define (to-sexp t)
|
||||
(map (match-lambda [(cons k v) (list k v)]) t))
|
||||
(define (to-sexp t) (hash-map list t))
|
||||
|
||||
;; union/value : table(k,v) table(k,v) (v v -> v) -> table(k,v)
|
||||
(define (union/value t1 t2 f)
|
||||
(define ks1 (map car t1))
|
||||
(define ks2 (map car t2))
|
||||
;; everything but the common ones
|
||||
(define t1* (filter (match-lambda [(cons k v) (not (memq k ks2))]) t1))
|
||||
(define t2* (filter (match-lambda [(cons k v) (not (memq k ks1))]) t2))
|
||||
(define pre-result (append t1* t2*))
|
||||
;; the common ones
|
||||
(define *t1 (filter (match-lambda [(cons k v) (memq k ks2)]) t1))
|
||||
(define *t2 (filter (match-lambda [(cons k v) (memq k ks1)]) t2))
|
||||
(define merged (map (match-lambda [(cons k v1)
|
||||
(let ([v2 (cdr (assq k *t2))])
|
||||
(cons k (f v1 v2)))])
|
||||
*t1))
|
||||
(append pre-result merged))
|
||||
;; union/value : table(k,v) table(k,v) [(v v -> v)] -> table(k,v)
|
||||
(define (union/value t1 t2 [f (lambda (x y) x)])
|
||||
(for/fold ([new-table t1])
|
||||
([(k v) t2])
|
||||
(cond [(hash-ref new-table k #f)
|
||||
=>
|
||||
(lambda (v*) (hash-set new-table k (f v* v)))]
|
||||
[else
|
||||
(hash-set new-table k v)])))
|
||||
|
||||
(define (make-eq) null)
|
||||
(define make-eq make-immutable-hasheq)
|
||||
|
||||
(define (lookup k t)
|
||||
(cond [(assq k t) => cdr]
|
||||
[else #f]))
|
||||
(define (lookup k t) (hash-ref t k #f))
|
||||
|
||||
(define (insert k v t)
|
||||
(cons (cons k v) t))
|
||||
(define (insert k v t) (hash-set t k v))
|
|
@ -97,10 +97,9 @@
|
|||
(if rst
|
||||
#'(dom* ... #:rest (listof rst*) . -> . rng*)
|
||||
#'(dom* ... . -> . rng*))))
|
||||
(let ([l (map f arrs)])
|
||||
(if (and (pair? l) (null? (cdr l)))
|
||||
#`(case-> #,@l)
|
||||
#`(case-> #,@l))))]
|
||||
(match (map f arrs)
|
||||
[(list e) e]
|
||||
[l #`(case-> #,@l)]))]
|
||||
[(Vector: t)
|
||||
#`(vectorof #,(t->c t))]
|
||||
[(Pair: t1 t2)
|
||||
|
|
Loading…
Reference in New Issue
Block a user