87 lines
3.1 KiB
Scheme
87 lines
3.1 KiB
Scheme
#lang scheme/base
|
|
(require scheme/contract
|
|
scheme/dict)
|
|
|
|
; list-prefix : list? list? -> boolean?
|
|
; Is l a prefix or r?
|
|
(define (list-prefix? ls rs)
|
|
(or (null? ls)
|
|
(and (pair? rs)
|
|
(equal? (car ls) (car rs))
|
|
(list-prefix? (cdr ls) (cdr rs)))))
|
|
|
|
;; Eli: Is this some `match' obsession syndrom? The simple definition:
|
|
;; (define (list-prefix? ls rs)
|
|
;; (or (null? ls) (and (pair? rs) (equal? (car ls) (car rs))
|
|
;; (list-prefix? (cdr ls) (cdr rs)))))
|
|
;; is shorter, and faster. As for making this a library function: how
|
|
;; about a version that removes the equal prefix from two lists and
|
|
;; returns the tails -- this way you can tell if they're equal, or one
|
|
;; is a prefix of the other, or if there was any equal prefix at all.
|
|
;; (Which can be useful for things like making a path relative to
|
|
;; another path.) A nice generalization is to make it get two or more
|
|
;; lists, and return a matching number of values.
|
|
;; ryanc: changed to use Eli's version
|
|
|
|
(provide/contract
|
|
[list-prefix? (list? list? . -> . boolean?)])
|
|
|
|
(define (filter-multiple l . fs)
|
|
(apply values
|
|
(map (lambda (f) (filter f l)) fs)))
|
|
|
|
;; Listof[A] Listof[B] B -> Listof[B]
|
|
;; pads out t to be as long as s
|
|
(define (extend s t extra)
|
|
(append t (build-list (max 0 (- (length s) (length t))) (lambda _ extra))))
|
|
|
|
(provide filter-multiple extend)
|
|
|
|
;; ryanc added:
|
|
|
|
(provide/contract
|
|
[check-duplicate
|
|
(->* (list?)
|
|
(#:key (-> any/c any/c)
|
|
#:same? (or/c dict? (-> any/c any/c any/c)))
|
|
any)])
|
|
|
|
;; check-duplicate : (listof X)
|
|
;; #:key (X -> K)
|
|
;; #:same? (or/c (K K -> bool) dict?)
|
|
;; -> X or #f
|
|
(define (check-duplicate items
|
|
#:key [key values]
|
|
#:same? [same? equal?])
|
|
(cond [(procedure? same?)
|
|
(cond [(eq? same? equal?)
|
|
(check-duplicate/t items key (make-hash) #t)]
|
|
[(eq? same? eq?)
|
|
(check-duplicate/t items key (make-hasheq) #t)]
|
|
[(eq? same? eqv?)
|
|
(check-duplicate/t items key (make-hasheqv) #t)]
|
|
[else
|
|
(check-duplicate/list items key same?)])]
|
|
[(dict? same?)
|
|
(let ([dict same?])
|
|
(if (dict-mutable? dict)
|
|
(check-duplicate/t items key dict #t)
|
|
(check-duplicate/t items key dict #f)))]))
|
|
(define (check-duplicate/t items key table mutating?)
|
|
(let loop ([items items] [table table])
|
|
(and (pair? items)
|
|
(let ([key-item (key (car items))])
|
|
(if (dict-ref table key-item #f)
|
|
(car items)
|
|
(loop (cdr items) (if mutating?
|
|
(begin (dict-set! table key-item #t) table)
|
|
(dict-set table key-item #t))))))))
|
|
(define (check-duplicate/list items key same?)
|
|
(let loop ([items items] [sofar null])
|
|
(and (pair? items)
|
|
(let ([key-item (key (car items))])
|
|
(if (for/or ([prev (in-list sofar)])
|
|
(same? key-item prev))
|
|
(car items)
|
|
(loop (cdr items) (cons key-item sofar)))))))
|