124 lines
4.2 KiB
Racket
124 lines
4.2 KiB
Racket
#lang s-exp "../kernel.rkt"
|
|
(provide (rename-out [map2 map]
|
|
[for-each2 for-each]
|
|
[andmap2 andmap]
|
|
[ormap2 ormap]))
|
|
|
|
;; -------------------------------------------------------------------------
|
|
|
|
(define map2
|
|
(let ([map
|
|
(case-lambda
|
|
[(f l)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 1)
|
|
(list? l))
|
|
(let loop ([l l])
|
|
(cond
|
|
[(null? l) null]
|
|
[else (cons (f (car l)) (loop (cdr l)))]))
|
|
(map f l))]
|
|
[(f l1 l2)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 2)
|
|
(list? l1)
|
|
(list? l2)
|
|
(= (length l1) (length l2)))
|
|
(let loop ([l1 l1][l2 l2])
|
|
(cond
|
|
[(null? l1) null]
|
|
[else (cons (f (car l1) (car l2))
|
|
(loop (cdr l1) (cdr l2)))]))
|
|
(map f l1 l2))]
|
|
[(f . args) (apply map f args)])])
|
|
map))
|
|
|
|
(define for-each2
|
|
(let ([for-each
|
|
(case-lambda
|
|
[(f l)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 1)
|
|
(list? l))
|
|
(let loop ([l l])
|
|
(cond
|
|
[(null? l) (void)]
|
|
[else (begin (f (car l)) (loop (cdr l)))]))
|
|
(for-each f l))]
|
|
[(f l1 l2)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 2)
|
|
(list? l1)
|
|
(list? l2)
|
|
(= (length l1) (length l2)))
|
|
(let loop ([l1 l1][l2 l2])
|
|
(cond
|
|
[(null? l1) (void)]
|
|
[else (begin (f (car l1) (car l2))
|
|
(loop (cdr l1) (cdr l2)))]))
|
|
(for-each f l1 l2))]
|
|
[(f . args) (apply for-each f args)])])
|
|
for-each))
|
|
|
|
(define andmap2
|
|
(let ([andmap
|
|
(case-lambda
|
|
[(f l)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 1)
|
|
(list? l))
|
|
(if (null? l)
|
|
#t
|
|
(let loop ([l l])
|
|
(cond
|
|
[(null? (cdr l)) (f (car l))]
|
|
[else (and (f (car l)) (loop (cdr l)))])))
|
|
(andmap f l))]
|
|
[(f l1 l2)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 2)
|
|
(list? l1)
|
|
(list? l2)
|
|
(= (length l1) (length l2)))
|
|
(if (null? l1)
|
|
#t
|
|
(let loop ([l1 l1][l2 l2])
|
|
(cond
|
|
[(null? (cdr l1)) (f (car l1) (car l2))]
|
|
[else (and (f (car l1) (car l2))
|
|
(loop (cdr l1) (cdr l2)))])))
|
|
(andmap f l1 l2))]
|
|
[(f . args) (apply andmap f args)])])
|
|
andmap))
|
|
|
|
(define ormap2
|
|
(let ([ormap
|
|
(case-lambda
|
|
[(f l)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 1)
|
|
(list? l))
|
|
(if (null? l)
|
|
#f
|
|
(let loop ([l l])
|
|
(cond
|
|
[(null? (cdr l)) (f (car l))]
|
|
[else (or (f (car l)) (loop (cdr l)))])))
|
|
(ormap f l))]
|
|
[(f l1 l2)
|
|
(if (and (procedure? f)
|
|
(procedure-arity-includes? f 2)
|
|
(list? l1)
|
|
(list? l2)
|
|
(= (length l1) (length l2)))
|
|
(if (null? l1)
|
|
#f
|
|
(let loop ([l1 l1][l2 l2])
|
|
(cond
|
|
[(null? (cdr l1)) (f (car l1) (car l2))]
|
|
[else (or (f (car l1) (car l2))
|
|
(loop (cdr l1) (cdr l2)))])))
|
|
(ormap f l1 l2))]
|
|
[(f . args) (apply ormap f args)])])
|
|
ormap))
|