154 lines
3.4 KiB
Scheme
154 lines
3.4 KiB
Scheme
#lang scheme/base
|
|
|
|
(provide mmap
|
|
mfor-each
|
|
mlist
|
|
mlist?
|
|
mlength
|
|
mappend
|
|
mreverse
|
|
mlist-tail
|
|
mlist-ref
|
|
mmemq
|
|
mmemv
|
|
mmember
|
|
massq
|
|
massv
|
|
massoc
|
|
mlist->list
|
|
list->mlist
|
|
mlistof)
|
|
|
|
(define mmap
|
|
(case-lambda
|
|
[(f l) (let loop ([l l])
|
|
(cond
|
|
[(null? l) null]
|
|
[else (mcons (f (mcar l)) (loop (mcdr l)))]))]
|
|
[(f l1 l2) (let loop ([l1 l1][l2 l2])
|
|
(cond
|
|
[(null? l1) null]
|
|
[else (mcons (f (mcar l1) (mcar l2))
|
|
(loop (mcdr l1) (mcdr l2)))]))]
|
|
[(f l . ls) (let loop ([l l][ls ls])
|
|
(cond
|
|
[(null? l) null]
|
|
[else (mcons (apply f (mcar l) (map mcar ls))
|
|
(loop (mcdr l) (map mcdr ls)))]))]))
|
|
|
|
(define mfor-each
|
|
(case-lambda
|
|
[(f l) (let loop ([l l])
|
|
(cond
|
|
[(null? l) (void)]
|
|
[else (f (mcar l))
|
|
(loop (mcdr l))]))]
|
|
[(f l1 l2) (let loop ([l1 l1][l2 l2])
|
|
(cond
|
|
[(null? l1) (void)]
|
|
[else (f (mcar l1) (mcar l2))
|
|
(loop (mcdr l1) (mcdr l2))]))]
|
|
[(f l . ls) (let loop ([l l][ls ls])
|
|
(cond
|
|
[(null? l) (void)]
|
|
[else (apply f (mcar l) (map mcar ls))
|
|
(loop (mcdr l) (map mcdr ls))]))]))
|
|
|
|
(define (list->mlist l)
|
|
(cond
|
|
[(null? l) null]
|
|
[else (mcons (car l) (list->mlist (cdr l)))]))
|
|
|
|
(define (mlist->list l)
|
|
(cond
|
|
[(null? l) null]
|
|
[else (cons (mcar l) (mlist->list (mcdr l)))]))
|
|
|
|
(define mlist
|
|
(case-lambda
|
|
[() null]
|
|
[(a) (mcons a null)]
|
|
[(a b) (mcons a (mcons b null))]
|
|
[(a b c) (mcons a (mcons b (mcons c null)))]
|
|
[(a b c d) (mcons a (mcons b (mcons c (mcons d null))))]
|
|
[l (list->mlist l)]))
|
|
|
|
(define (mlist? l)
|
|
(cond
|
|
[(null? l) #t]
|
|
[(mpair? l) (mlist? (mcdr l))]
|
|
[else #f]))
|
|
|
|
(define (mlength l)
|
|
(let loop ([l l][len 0])
|
|
(cond
|
|
[(null? l) len]
|
|
[else (loop (mcdr l) (add1 len))])))
|
|
|
|
(define mappend
|
|
(case-lambda
|
|
[() null]
|
|
[(a) a]
|
|
[(a b) (let loop ([a a])
|
|
(if (null? a)
|
|
b
|
|
(mcons (mcar a) (loop (mcdr a)))))]
|
|
[(a . l) (mappend a (apply mappend l))]))
|
|
|
|
(define (mreverse l)
|
|
(let loop ([l l][a null])
|
|
(cond
|
|
[(null? l) a]
|
|
[else (loop (mcdr l) (mcons (mcar l) a))])))
|
|
|
|
(define (mlist-tail l n)
|
|
(cond
|
|
[(zero? n) l]
|
|
[else (mlist-tail (mcdr l) (sub1 n))]))
|
|
|
|
(define (mlist-ref l n)
|
|
(cond
|
|
[(zero? n) (mcar l)]
|
|
[else (mlist-ref (mcdr l) (sub1 n))]))
|
|
|
|
(define (do-member =? v l)
|
|
(let loop ([l l])
|
|
(cond
|
|
[(null? l) #f]
|
|
[(=? v (mcar l)) l]
|
|
[else (loop (mcdr l))])))
|
|
|
|
(define (mmemq v l)
|
|
(do-member eq? v l))
|
|
|
|
(define (mmemv v l)
|
|
(do-member eqv? v l))
|
|
|
|
(define (mmember v l)
|
|
(do-member equal? v l))
|
|
|
|
|
|
(define (do-assoc =? v l)
|
|
(let loop ([l l])
|
|
(cond
|
|
[(null? l) #f]
|
|
[(=? v (mcar (mcar l))) (mcar l)]
|
|
[else (loop (mcdr l))])))
|
|
|
|
(define (massq v l)
|
|
(do-assoc eq? v l))
|
|
|
|
(define (massv v l)
|
|
(do-assoc eqv? v l))
|
|
|
|
(define (massoc v l)
|
|
(do-assoc equal? v l))
|
|
|
|
(define ((mlistof p?) l)
|
|
(let loop ([l l])
|
|
(cond
|
|
[(null? l) #t]
|
|
[(not (mpair? l)) #f]
|
|
[(p? (mcar l)) (loop (mcdr l))]
|
|
[else #f])))
|