# Wolsty: lambdaを隠した書き方につかえる関数まとめ

これまで投稿してた Scheme で `lambda` を隠した書き方をするのにつかう関数の定義をまとめてみた。

```(use-modules (srfi srfi-1)) ; assoc, fild-tail, fold, for-each, map, every, unfold

(define (echo x0 . fs) (fold (lambda (fi xi) (fi xi)) x0 fs))
(define (&\$ . fs)    (lambda (x0) (fold (lambda (fi xi) (fi xi)) x0 fs)))
(define (\$\$ f0 . fs) (lambda xs (fold (lambda (fi xi) (fi xi)) (apply f0 xs) fs)))
(define (*~ f . <<)  (lambda >> (apply f (append << >>))))
(define (~* f . >>)  (lambda << (apply f (append << >>))))
(define (?~ f)       (lambda << (lambda >> (apply f (append << >>)))))
(define (~? f)       (lambda >> (lambda << (apply f (append << >>)))))
(define (-<\$ . fs)   (lambda xs (map (lambda (f) (apply f xs)) fs)))
(define (//\$ . fs)   (lambda (xs) (map (lambda (fi xi) (fi xi)) fs xs)))
(define (each f)     (lambda (xs) (map f xs)))
(define (\$->& f)     (lambda (xs) (apply f xs)))
(define (&->\$ f)     (lambda xs (apply f (list xs))))
(define (! . xs)     (lambda _ (apply values xs)))

(define (wnl . xs) (for-each write xs) (newline) (apply values xs))
(define (dnl . xs) (for-each display xs) (newline) (apply values xs))

(define (<&&> . fs)
(if (null? fs)
(lambda (o) #t)
; else
(lambda (o)
(let trace ((fs fs))
(if (null? (cdr fs))
((car fs) o)
; else
(and ((car fs) o) (trace (cdr fs)))
)
) ; let
) ; lambda
) ; if
) ; define <&&>

(define (<||> . fs)
(if (null? fs)
(lambda (o) #f)
; else
(lambda (o)
(let trace ((fs fs))
(if (null? (cdr fs))
((car fs) o)
; else
(or ((car fs) o) (trace (cdr fs)))
)
) ; let
) ; lambda
) ; if
) ; define <&&>

; Q : a->Boolean
; T : a->b
; F : a->b

(define (?: Q T F) (lambda (x) (if (Q x) (T x) (F x))))

; QTs : [(a->Boolean, a->b)]
; F   : a->b

(define (?:? QTs F)
(lambda (x)
(let seq ((QTs QTs))
(cond
((null? QTs) (F x))
(((caar QTs) x) ((cadr QTs) x))
(else (seq (cdr QTs)))
) ; cond
) ; let seq
) ; lambda
) ; define ?:?

;; QTs : [(a->Boolean, b)]
;; F   : b

(define (?:! QTs F)
(lambda (x)
(let ((qt (find-tail (lambda (qt) ((car qt) x)) QTs)))
) ; let qt
) ; lambda
) ; define ?:!

;; QTs : [(a, a->b)]
;; F   : a->b

(define (!:? QTs F . ==)
(set! == (if (pair? ==) (cadr ==) equal?))
(lambda (x)
(let ((qt (assoc x QTs ==)))
((if qt (cadr qt) F) x)
) ; let qt
) ; lambda
) ; define !:?

;; QTs : [(a, b)]
;; F   : b

(define (!:! QTs F . ==)
(set! == (if (pair? ==) (cadr ==) equal?))
(lambda (x)
(let ((qt (assoc x QTs ==)))
) ; let qt
) ; lambda
) ; define !:!

(define (\$.. f . fs)
(set! fs (cons f fs))
(lambda xs
(let trace ((fs fs))
(if (null? (cdr fs))
(apply (car fs) xs)
; else
(begin
(apply (car fs) xs)
(trace (cdr fs))
)
)
) ; let
) ; lambda
) ; define \$..

(define new_Function.Effector.Property list)
(define Function.Effector.Property_instance? car)

;; instance? : Any->Boolean
;; getter    : a->b
;; setter    : a,b->a

(define (Function.Effector effProp replace)
(lambda (o)
((Function.Effector.Property_setter effProp) o
(replace ((Function.Effector.Property_getter effProp) o))
)
)
)

(define >E Function.Effector)

(define (Function.EffectorTo effProp replace)
(lambda (o)
(if ((Function.Effector.Property_instance? effProp) o)
((Function.Effector.Property_setter effProp) o
(replace ((Function.Effector.Property_getter effProp) o))
)
; else
o
)
)
)
```