Name:
Anonymous
2012-11-14 4:47
(define (reduce op id lis)
(if (null? lis)
id
(reduce op (op id (car lis)) (cdr lis))))
(define (flip f)
(lambda (x y) (f y x)))
(define (curry f . args)
(lambda args2
(apply f (append args args2))))
(define (evaluate f x) (f x))
(define (compose . fns)
(let ((rev-fns (reverse fns)))
(lambda args
(reduce (flip evaluate) (apply (car rev-fns) args) (cdr rev-fns)))))
(define (collect . fns)
(lambda args
(map (curry (flip apply) args) fns)))
(define (wrap f . fns)
(compose (curry apply f) (apply collect fns)))
(define (if-fn condition true false)
(lambda args
(if (apply condition args)
(apply true args)
(apply false args))))
(define (constant-fn value)
(lambda args value))
(define (id x) x)
(define factorial-helper
(if-fn (compose (curry = 0) caddr list)
(compose cadr list)
(compose (wrap apply car id) (collect car (wrap * cadr caddr) (compose (curry (flip -) 1) caddr)) list)))
(define factorial (curry factorial-helper factorial-helper 1))
Name:
Anonymous
2012-11-17 4:34
Ok, final draft. Isn't it beautifu?
(define (reduce op id lis)
(if (null? lis)
id
(reduce op (op id (car lis)) (cdr lis))))
(define (flip f)
(lambda (x y) (f y x)))
(define (curry f . args)
(lambda args2
(apply f (append args args2))))
(define (evaluate f x) (f x))
(define (compose . fns)
(let ((rev-fns (reverse fns)))
(lambda args
(reduce (flip evaluate) (apply (car rev-fns) args) (cdr rev-fns)))))
(define (all? . args)
(cond ((null? args) #t)
((not (car args)) (car args))
((null? (cdr args)) (car args))
(else (apply all? (cdr args)))))
(define (exists? . args)
(cond ((null? args) #f)
((car args) (car args))
((null? (cdr args)) (car args))
(else (apply exists? (cdr args)))))
(define (id x) x)
(define factorial-helper (compose (curry apply apply) ((compose (curry apply
compose) (curry (flip cons) (list (curry curry (flip apply)) list)) (curry
curry (flip map)) list) (compose (curry vector-ref (vector (compose cadr list)
(compose (curry apply apply) ((compose (curry apply compose) (curry (flip
cons) (list (curry curry (flip apply)) list)) (curry curry (flip map)) list)
car id) ((compose (curry apply compose) (curry (flip cons) (list (curry curry
(flip apply)) list)) (curry curry (flip map)) list) car (compose (curry apply
*) ((compose (curry apply compose) (curry (flip cons) (list (curry curry (flip
apply)) list)) (curry curry (flip map)) list) cadr caddr)) (compose (curry
(flip -) 1) caddr)) list))) car) (compose cadr)) ((compose (curry apply
compose) (curry (flip cons) (list (curry curry (flip apply)) list)) (curry
curry (flip map)) list) (compose (curry (flip exists?) 1) (curry (flip all?)
0) (curry = 0) caddr) id) list))
(define factorial (curry factorial-helper factorial-helper 1))