# boolean false = \ t f . f true = \ t f . t and = \ a b . a b a or = \ a b . a a b not = \ a . a false true # function id = \ a . a const = \ a b . a compose = \ bc ab a . bc (ab a) flip = \ abc b a . abc a b fix = \ f . (\x . f (x x)) (\x . f (x x)) error = \e . error e seq = \ a ! \b . b # list nil = \ c n . n cons = \ x xs c n . c x xs null = \ l . l (\x xs . false) true head = \ l . l (\x xs . x) (error head) tail = \ l . l (\x xs . xs) (error tail) map = \ f l . l (\x xs . cons (f x) (map f xs)) nil append = \ us vs . us (\x xs . cons x (append xs vs)) vs filter = \ p l . l (\x xs . p x (cons x) id (filter p xs)) nil index = \ l n . n (\p . l (\x xs . index xs p) (error index)) (l (\x xs . x) (error index)) reverse = \ l . l (\x xs . append (reverse xs) (cons x nil)) nil foldr = \ f e l . l (\x xs . f x (foldr f e xs)) e length = foldr (const succ) zero ands = foldr and true ors = foldr or false concat = foldr append nil all = \f . compose ands (map f) any = \f . compose ors (map f) concatMap = \f . compose concat (map f) composes = foldr compose id sum = foldr add zero product = foldr mul (succ zero) repeat = \x . cons x (repeat x) cycle = compose concat repeat take = \n l . n (\p . l (\x xs . cons x (take p xs)) nil) nil drop = \n l . n (\p . l (\x xs . drop p xs) nil) l transpose = \l . l (\xs xss . xs (\y ys . cons (cons y (concatMap (take 1) xss)) (transpose (cons ys (map (drop 1) xss)))) (transpose xss)) nil iterate = \f x . cons x (iterate f (f x)) last = \l . l (\x xs . xs (\y ys . last xs) x) (error last) replicate = \n x . take n (repeat x) # natural zero = \ s z . z succ = \ n s z . s n infinity = succ infinity even = \n . n odd true odd = \n . n even false add = \ m n . m (\p . succ (add n p)) n mul = \ m n . m (\p . add n (mul n p)) zero exp = \ m n . n (\p . mul m (exp m p)) one sub = \ m n . m (\p . n (sub p) m) zero equal = \ m n . m (\mm . n (\nn . equal mm nn) false) (n (\nn . false) true)